perm filename QIO.248[MAC,LSP] blob
sn#251577 filedate 1976-12-02 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00027 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002
C00007 00003
C00011 00004
C00017 00005
C00019 00006
C00022 00007
C00026 00008
C00028 00009
C00031 00010
C00033 00011
C00036 00012
C00039 00013
C00043 00014
C00046 00015
C00051 00016
C00076 00017
C00078 00018
C00080 00019
C00083 00020
C00085 00021
C00086 00022
C00089 00023
C00092 00024
C00095 00025
C00098 00026
C00100 00027
C00103 ENDMK
C⊗;
;;; **************************************************************
;;; ***** MACLISP ****** NEW MULTIPLE FILE I/O FUNCTIONS *********
;;; **************************************************************
;;; ** (C) COPYRIGHT 1976 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;; ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;; **************************************************************
PGBOT [QIO]
SUBTTL I/O CHANNEL ALLOCATOR
;;; ALCHAN ALLOCATES AN I/O CHANNEL FOR USE. IT EXPECTS THE
;;; SAR FOR THE FILE ARRAY TO BE IN A, AND RETURNS THE
;;; CHANNEL NUMBER IN F, SKIPPING IF SUCCESSFUL.
;;; THE FILE ARRAY MUST HAVE ITS TTS.CL BIT SET.
;;; USER INTERRUPTS TURNED OFF, PLEASE. CLOBBERS R.
;;; MAY INVOKE A GARBAGE COLLECTION TO FREE UP CHANNELS.
ALCHAN: HRRZS (P)
ALCHN0: MOVEI F,LCHNTB-1 ;SCAN CHANNEL TABLE
ALCHN1: SKIPN R,CHNTB(F)
JRST ALCHN3 ;FOUND A FREE CHANNEL
MOVE R,TTSAR(R)
TLNE R,TTS<CL>
JRST ALCHN2 ;SEMI-FREE CHANNEL
SOJG F,ALCHN1 ;NOT SOJGE - TMPC NEVER FREE
SKIPGE (P) ;SKIP IF FIRST TIME
POPJ P, ;LOSEY LOSEY
HRROS (P) ;SET SWITCH
PUSH P,[555555,,ALCHN0]
JRST AGC ;HOPE GC WILL RECLAIM A FILE ARRAY
ALCHN2: .CALL ALCHN9 ;CLOSE CHANNEL TO BE SURE
.VALUE
ALCHN3: MOVE R,TTSAR(A) ;INSTALL CHANNEL NUMBER
MOVEM F,F.CHAN(R)
MOVEM A,CHNTB(F) ;RESERVE CHANNEL
JRST POPJ1 ;WIN WIN - SKIP RETURN
ALCHN9: SETZ
SIXBIT \CLOSE\ ;CLOSE I/O CHANNEL
400000,,F ;CHANNEL #
;;; ALFILE CREATES A MINIMAL FILE ARRAY (OF LENGTH LOPOFA),
;;; ALLOCATES A CHANNEL, AND PUTS THE CHANNEL NUMBER INTO
;;; THE F.CHAN SLOT OF THE FILE ARRAY. IT EXPECTS A LEFT-
;;; JUSTIFIED DEVICE NAME IN TT WHICH IS INSTALLED IN THE
;;; F.DEV SLOT OF THE FILE ARRAY. THIS IS USEFUL FOR ROUTINES
;;; WHICH WANT TO HACK ON A RANDOM CHANNEL BUT DON'T NEED
;;; A FULL-BLOWN FILE ARRAY. A FILE ARRAY IS NEEDED FOR
;;; THE SAKE OF THE CHANNEL TABLE (CHNTB) AND FOR THE GARBAGE
;;; COLLECTOR; IF THE FILE ARRAY IS GARBAGE COLLECTED, SO IS
;;; THE ASSOCIATED CHANNEL. THE FILE ARRAY ALSO MUST
;;; CONTAIN AT LEAST A DEVICE NAME SO PRIN1 CAN WIN.
;;; CLOBBERS PRACTICALLY ALL ACS.
;;; THE ARRAY GC POINTER IS SET TO PROTECT THE FIRST SLOT ONLY.
;;; RETURNS FILE ARRAY IN A, CHANNEL NUMBER IN F.
;;; SKIPS ON SUCCESS; FAILS IF ALCHAN CAN'T GET A CHANNEL.
ALFILE: LOCKI
PUSH FXP,TT
MOVEI TT,LOPOFA ;LENGTH OF PLAIN OLD FILE ARRAY
MOVSI A,-1 ;GET ONLY A SAR
PUSHJ P,MKLSAR
MOVSI TT,TTS<CL> ;SET CLOSED BIT
IORB TT,TTSAR(A)
MOVSI T,AS<FIL> ;SET FILE ARRAY BIT (MUST DO
IORB T,ASAR(A) ; IN THIS ORDER!)
HRROS -1(T)
POP FXP,T
MOVEM T,F.DEV(TT) ;INSTALL DEVICE NAME
MOVEM T,F.RDEV(TT)
MOVSI T,FBT.CM ;PREVENT GC FROM TRYING TO
MOVEM T,F.MODE(TT) ; UPDATE NONEXISTENT POINTERS
PUSHJ P,ALCHAN
JRST UNLKPJ
AOS (P) ;WE SKIP IFF ALCHAN DOES
MOVSI TT,TTS<CL>
ANDCAM TT,TTSAR(A)
UNLKPJ: UNLKPOPJ
SUBTTL FILE OBJECT CHECKING ROUTINES
;;; JSP TT,XFILEP
;;; SKIPS IFF THE OBJECT IN AR1 IS A FILE ARRAY. CLOBBERS R.
AFILEP: MOVEI AR1,(A)
XFILEP: MOVEI R,(AR1)
LSH R,-SEGLOG
MOVE R,ST(R)
TLNN R,SA
JRST (TT)
MOVE R,ASAR(AR1) ;MUST ALSO HAVE FILE BIT SET
TLNN R,AS<FIL>
JRST (TT)
JRST 1(TT)
;;; THESE ROUTINES ACCEPT A FILE ARRAY IN AR1 AND CHECK WHETHER
;;; IT IS OF THE DESIRED TYPE. IF NOT, A WTA ERROR OCCURS.
;;; LEAVES TTSAR IN TT AND USER INTS LOCKED IF SUCCESSFUL.
;;; CLOBBERS T, TT, AND R. SAVES D (SEE FILEPOS) AND F.
OFILOK: JSP T,FILOK0 ;TYPICAL INVOCATION:
TTS<IO>,,TTS<IO> ; DESIRED BITS,,MASK
SIXBIT \NOT OUTPUT FILE!\ ; ERROR MSG IF FAIL
IFILOK: JSP T,FILOK0
0,,TTS<IO>
SIXBIT \NOT INPUT FILE!\
ATFLOK: JSP T,FILOK0
0,,TTS<BN>
SIXBIT \NOT ASCII FILE!\
ATOFOK: JSP T,FILOK0
TTS<IO>,,TTS<BN+IO>
SIXBIT \NOT ASCII OUTPUT FILE!\
ATIFOK: JSP T,FILOK0
0,,TTS<BN+IO>
SIXBIT \NOT ASCII INPUT FILE!\
TFILOK: JSP T,FILOK0
TTS<TY>,,TTS<TY>
SIXBIT \NOT TTY FILE!\
TIFLOK: JSP T,FILOK0
TTS<TY>,,TTS<TY+IO>
SIXBIT \NOT TTY INPUT FILE!\
TOFLOK: JSP T,FILOK0
TTS<TY+IO>,,TTS<TY+IO>
SIXBIT \NOT TTY OUTPUT FILE!\
XIFLOK: JSP T,FILOK0
TTS<BN>,,TTS<IM+BN+TY+IO>
SIXBIT \NOT BINARY INPUT FILE!\
XOFLOK: JSP T,FILOK0
TTS<BN+IO>,,TTS<IM+BN+TY+IO>
SIXBIT \NOT BINARY OUTPUT FILE!\
FILOK: JSP T,FILOK0
0,,0
NFILE: SIXBIT \NOT FILE!\
FILOK0: LOCKI
CAIE AR1,TRUTH ;T => TTY FILE ARRAY
JRST FILOK1
MOVSI TT,TTS<IO>
TSNE TT,(T) ;IF DON'T CARE ABOUT I/O
TDNE TT,(T) ; OR SPECIFICALLY WANT OUTPUT
SKIPA AR1,V%TYO ; THEN USE TTY OUTPUT
HRRZ AR1,V%TYI ;USE TTY INPUT ONLY IF NECESSARY
FILOK1: JSP TT,XFILEP ;SO IS IT A FILE ARRAY?
JRST FILNOK ;NOPE - LOSE
MOVE TT,TTSAR(AR1)
XOR TT,(T)
HLL T,TT
MOVE TT,TTSAR(AR1) ;WANT TO RETURN TTSAR IN TT
TLNE T,@(T)
JRST FILNOK
TLNN TT,TTS<CL>
POPJ P, ;YEP - WIN
SKIPA TT,[[SIXBIT \FILE HAS BEEN CLOSED!\]]
FILNOK: MOVEI TT,1(T)
EXCH A,AR1
UNLOCKI
%WTA (TT)
EXCH A,AR1
JRST FILOK0
SUBTTL CONVERSION: NAMELIST => SIXBIT
;;; A NAMELIST IN A IS CONVERTED TO FOUR SIXBIT WORDS ON
;;; THE FIXNUM PDL IN THE ORDER
;;; <DEVICE> <SNAME/PPN> <FILE NAME 1> <FILE NAME 2>
;;; THERE ARE TWO KINDS OF NAMELIST: SHORT AND FULL.
;;; A SHORT NAMELIST IS UREAD-STYLE: TWO FILE NAMES, A DEVICE
;;; NAME, AND AN SNAME/PPN. A FULL NAMELIST HAS THE DEVICE
;;; AND SNAME/PPN IN THE CAR (WHICH IS NON-ATOMIC) AND THE
;;; FILE NAMES ON THE CDR.
NML6BT: JSP T,QIOSAV
NML6B5: PUSH P,A
HLRZ A,(A)
PUSHJ P,ATOM
JUMPN A,NML6B2
HLRZ A,@(P)
PUSHJ P,NML6DV ;SKIPS IF OKAY
JRST NML6B0
HRRZ A,@(P)
PUSHJ P,NML6FN
JUMPE A,POP1J
NML6BZ: SUB FXP,R70+2
NML6B0: SUB FXP,R70+2
POP P,A
WTA [INCOMPREHENSIBLE NAMELIST!]
JRST NML6B5
NML6B2: HRRZ A,(P) ;SUBROUTINE - STACKS UP TWO GOODIES ON FXP
PUSHJ P,NML6FN
MOVSI T,(SIXBIT \*\)
MOVSI TT,(SIXBITY \*\)
JUMPE A,NML6B3
PUSHJ P,NML6DV ;SKIPS IF OKAY
JRST NML6BZ
POP FXP,TT
POP FXP,T
NML6B3: EXCH T,-1(FXP)
EXCH TT,(FXP)
PUSH FXP,T
PUSH FXP,TT
JRST POP1J
NML6FN:
REPEAT 2, PUSH FXP,[SIXBIT \*\]
JUMPE A,FALSE
MOVEI B,IN0+10.
JSP T,SPECBIND
0 B,VBASE
0 B,V.NOPOINT
PUSH P,CUNBIND
MOVEI B,(A)
PUSHJ P,ATOM
EXCH B,A
JUMPE B,NML6F2
NML6F1: PUSHJ P,SIXMAK
MOVEM TT,(FXP)
JRST FALSE
NML6F2: PUSH P,A
HLRZ A,(A)
PUSHJ P,SIXMAK
MOVEM TT,-1(FXP)
HRRZ A,@(P)
JUMPE A,POP1J
MOVEM A,(P)
PUSHJ P,ATOM
JUMPE A,NML6F3
POP P,A
JRST NML6F1
NML6F3: HLRZ A,@(P)
PUSHJ P,NML6F1
HRRZ A,@(P)
JRST POP1J
NML6DV:
REPEAT 2, PUSH FXP,[SIXBIT \*\]
HRRZ B,(A)
HLRZ A,(A)
PUSH P,B
HRRZ TT,(B)
JUMPN TT,POP1J
AOS -1(P)
10% JUMPE B,IDND
PUSHJ P,SIXMAK
MOVEM TT,-1(FXP)
HLRZ A,@(P)
10% PUSHJ P,SIXMAK
IFN D10,[
IFE SAIL,[
JSP T,SPATOM
JRST .+3
PUSHJ P,SIXMAK ;SIXBIT PPN
JRST NML6D1
HLRZ B,(A)
JSP T,FXNV2 ;PROJ # IN D
HRRZ A,(A)
HLRZ A,(A)
JSP T,FXNV1 ;PROG # IN TT
HRLI TT,(D)
NML6D1:
] ;END OF IFE SAIL
IFN SAIL,[
HLRZ B,(A) ;PROJ# IN B
HRRZ A,(A)
HLRZ A,(A) ;PROG# IN A
PUSH P,B ;LH PART ON PDL
PUSHJ P,SIXMAK ;GET SIXBIT FOR RH PART
PUSHJ P,SARGT ;RIGHT JUSTIFY BOX
PUSH FXP,TT ;ON ANOTHER STACK
POP P,A ;LH IN A
PUSHJ P,SIXMAK ;GET SIXBIT FOR LH
PUSHJ P,SARGT ;R.J.
POP FXP,D
HLR TT,D ;INSTALL RH PART
] ;END OF IFN SAIL
] ;END OF IFN D10
IDNDSN: MOVEM TT,(FXP)
JRST POP1J
IFN SAIL,[
SARGT: TLNE TT,77 ;IS RIGHTMOST CHAR ZERO?
POPJ P, ;WIN
LSH TT,-6 ;SLYDE RIGHT
JRST SARGT ;ONE MORE TIME, NOW.
] ;END OF IFN SAIL
IFN ITS,[
;;; INSUFFERABLE DEVICE NAME DISTINGUISHER
IDND: PUSHJ P,SIXMAK
TRNE TT,-1
JRST IDNDSN
TLC TT,77 ;SIXBIT 77 = BACKARROW
TLCN TT,77
JRST IDNDSN
HLRZ D,TT
MOVEI R,(D)
ANDI R,7777
CAIG R,3177 ;SIXBIT 31 = 9
CAIGE R,2000 ;SIXBIT 20 = 0
CAIA
TRO D,7700
ANDI R,77
CAIG R,31
CAIGE R,20
CAIA
TRO D,77
MOVE R,[442200,,DEVNMS]
IDND2: ILDB T,R
JUMPE T,IDNDSN ;SIGH - MUST BE SNAME AFTER ALL
CAIE T,(D)
JRST IDND2
MOVEM TT,-1(FXP) ;IT'S A DEVICE NAME!
JRST POP1J
DEVNMS: SIXBIT \DSKSYS\
SIXBIT \COMAI \
SIXBIT \ML DM \
SIXBIT \TTYT←←\
SIXBIT \TY←STY\
SIXBIT \ST←S←←\
SIXBIT \PK←P←←\
SIXBIT \DK←UT←\
SIXBIT \MT←NUL\
SIXBIT \AR←DIR\
SIXBIT \LPTTPL\
SIXBIT \CLOCLU\
SIXBIT \CLICLA\
SIXBIT \USRDIS\
SIXBIT \JOBBOJ\ ;THIS STUFF GROWS
SIXBIT \OJBNET\ ; INCREASINGLY USELESS...
SIXBIT \PTPPTR\
SIXBIT \ERRSPY\
SIXBIT \COR \ ;" " => END OF LIST
] ;END OF IFN ITS
SUBTTL CONVERSION: SIXBIT => NAMELIST
;;; THIS ROUTINE TAKES FOUR WORDS OF SIXBIT ON THE FIXNUM
;;; PDL AND, POPPING THEM, RETURNS THE EQUIVALENT NAMELIST.
;;; ZERO WORDS BECOME *'S.
;;; NAMELIST FUNCTION MERELY CONVERTS ARG TO SIXBIT,
;;; THEN BACK TO NAMELIST FORM.
NAMELIST: PUSHJ P,FIL6BT ;SUBR 1
6BTNML: JSP T,QIOSAV ;MUST ALSO PRESERVE F
10$ HLLZS (FXP) ;DEC-10 FNAME2 IS 3 CHARS
PUSHJ P,6BTNL1 ;CONVERT FILE NAMES
PUSH P,A
10% PUSHJ P,6BTNL1 ;CONVERT DEVICE/SNAME
IFN D10,[
HLRZ TT,(FXP) ;FOR DEC-10, CONS UP PPN
JSP T,FXCONS
MOVEI B,(A)
POP FXP,TT
TLZ TT,-1
JSP T,FXCONS
PUSHJ P,ACONS
PUSHJ P,XCONS
PUSH P,A
POP FXP,TT ;NOW GET DEVICE NAME
PUSHJ P,SIXATM
PUSHJ P,6BTNL2 ;CONS TOGETHER
] ;END OF IFN D10
6BTNL2: POP P,B
JRST CONS
6BTNL1: POP FXP,TT ;MAKE LIST OF TWO NAMES
PUSHJ P,SIXATM
PUSHJ P,NCONS
PUSH P,A
POP FXP,TT
PUSHJ P,SIXATM
JRST 6BTNL2
SIXATM: SETOM LPNF ;TAKE SIXBIT IN TT, MAKE
MOVE C,PNBP ; ATOMIC SYMBOL. EMBEDDED
MOVSI T,(ASCII \*\) ; BLANKS COUNT, TRAILING DON'T.
MOVEM T,PNBUF ;ZERO WORD BECOMES *.
SETZM PNBUF+1
SIXAT1: JUMPE TT,RINTERN
SETZ T,
LSHC T,6
ADDI T,40
IDPB T,C
JRST SIXAT1
SUBTTL CONVERSION: SIXBIT => NAMESTRING
;;; THIS ROUTINE TAKES FOUR WORDS OF FILE SPECS ON THE FIXNUM
;;; PDL AND GENERATES AN UNINTERNED ATOMIC SYMBOL WHOSE
;;; PRINT NAME IS THE EXTERNAL FORM OF FILE SPECIFICATION.
;;; ZERO WORDS BECOME *'S.
;;; THE NAMESTRING AND SHORTNAMESTRING MERELY CONVERT THEIR
;;; ARGUMENTS TO SIXBIT AND THEN INTO NAMESTRING FORM.
SHORTNAMESTRING: HRROS (P) ;SUBR 1
NAMESTRING: PUSHJ P,FIL6BT ;SUBR 1
6BTNMS: SETOM LPNF ;WILL FIT IN PNBUF
MOVEI R,↑Q
MOVE C,PNBP
MOVE D,(P)
TLNE D,1 ;SKIP UNLESS SHORTNAMESTRING
JRST 6BTNS0
MOVE TT,-3(FXP) ;PUSH OUT DEVICE
MOVEI D,":
PUSHJ P,6BTNS1
10% MOVE TT,-2(FXP) ;PUSH OUT SNAME FOR ITS
10% MOVEI D,";
10% PUSHJ P,6BTNS1
6BTNS0: MOVE TT,-1(FXP) ;PUSH OUT FILE NAMES
10% MOVEI D,40 ; "FOOBAR QUUXLY" FOR ITS
10$ MOVEI D,". ; "FOOBAR.QUX" FOR DEC-10
PUSHJ P,6BTNS1
10% MOVE TT,(FXP)
10$ HLLZ TT,(FXP)
SETZ D,
PUSHJ P,6BTNS1
IFN D10,[
MOVE D,(P)
TLNE D,1 ;SKIP UNLESS SHORTNAMESTRING
JRST 6BTNS8
MOVEI D,133 ;HACK DEC-10 PPN IN FORM
IDPB D,C ; "[0123,4567]"
HLRZ TT,-2(FXP)
PUSHJ P,6BTNS5
MOVEI D,",
IDPB D,C
HRRZ TT,-2(FXP)
PUSHJ P,6BTNS5
MOVEI D,135
IDPB D,C
] ;END OF IFN D10
6BTNS8: TLNN C,760000
JRST 6BTNS9
IDPB D,C
JRST 6BTNS8
6BTNS9: SUB FXP,R70+4
JRST PNGNK2
6BTNS1: SKIPN TT ;PUSH OUT ONE FILE NAME
MOVEI TT,(SIXBIT \*\)
6BTNS2: SETZ T,
LSHC T,6
JUMPE T,6BTNS3
10$ CAIE T,133-40 ;FOR DEC-10, BRACKETS MUST
10$ CAIN T,135-40 ; BE QUOTED
10$ JRST 6BTNS3
CAIE T,':
10% CAIN T,';
10$ CAIN T,'.
6BTNS3: IDPB R,C ;↑Q TO QUOTE FUNNY CHARS
ADDI T,40
IDPB T,C
JUMPN TT,6BTNS2
SKIPE D
IDPB D,C
POPJ P,
IFN D10,[
6BTNS5: LSHC TT,-3 ;OUTPUT HALF A PPN IN
LSH D,-41 ; ZERO-SUPPRESSED OCTAL
ADDI D,"0
HRLM D,(P)
SKIPE TT
PUSHJ P,6BTNS5
HLRZ D,(P)
IDPB D,C
POPJ P,
] ;END OF IFN D10
SUBTTL CONVERSION: NAMESTRING => SIXBIT
;;; THIS ONE IS PRETTY HAIRY. IT CONVERTS AN ATOMIC
;;; SYMBOL IN A, REPRESENTING A FILE SPECIFICATION,
;;; INTO FOUR WORDS WHICH ARE LEFT ON THE FIXNUM PDL.
;;; SPACE AND ALL CONTROL CHARACTERS BREAK FILE NAMES,
;;; EXCEPT ↑Q WHICH QUOTES SPACE, ":", AND ";".
;;; FOR DEC-10, ↑Q QUOTES ".", "[", AND "]" AS WELL.
;;; LOWER CASE (ASCII > 140) IS CONVERTED TO UPPER CASE.
NMS6B0: WTA [INCOMPREHENSIBLE NAMESTRING!]
NMS6BT: JSP T,0PUSH-5 ;WORKING ROOM
MOVEI AR1,(FXP) ;AR1 POINT TO WORDS OVER PRINTA
HRLI AR1,440600
HRROI R,NMS6B1
PUSH P,A
PUSHJ P,PRINTA ;EXPLODEC THE ATOM
MOVEI A,40
PUSHJ P,(R) ;MAYBE FINISH OFF LAST NAME
POP P,A
AOJE AR1,NMS6B0
SUB FXP,R70+1
MOVSI T,(SIXBIT \*\) ;UNSPECIFIED COMPONENTS BECOME *
REPEAT 4,[
SKIPN -.RPCNT(FXP)
MOVEM T,-.RPCNT(FXP)
] ;END OF REPEAT 4
POPJ P,
NMS6B1: CAMN AR1,XC-1 ;IF ERROR ENCOUNTERED,
POPJ P, ; IGNORE REST OF NAMESTRING
CAIE A,↑Q
JRST NMS6B2
TLCN AR1,1 ;BIT 3.1 OF AR1 IS ↑Q FLAG
POPJ P, ;↑Q↑Q IS A FILE NAME BREAK
NMS6B2: CAIL A,40
JRST NMS6B7
NMS6B8: SKIPN D,(AR1) ;IF NO FILE NAME YET, IGNORE
JRST NMS6B6
SKIPN -2(AR1) ;FIGURE OUT WHERE TO PUT THIS NAME
JSP AR2A,NMS6B5 ;FILE NAME 1 GETS FIRST CHOICE,
SKIPN -1(AR1) ; THEN FILE NAME 2
JSP AR2A,NMS6B5
SKIPN -4(AR1) ;NOW TRY DEVICE NAME
NMS6B3: JSP AR2A,NMS6B5
SKIPN -3(AR1) ;SNAME IS LAST HOPE
NMS6B4: JSP AR2A,NMS6B5
NMS6BL: SETO AR1, ;UGH BLETCH CHOKE
POPJ P,
NMS6B5: MOVEM D,@-2(AR2A)
SETZM (AR1)
NMS6B6: HRLI AR1,440600 ;RESET BYTE POINTER
POPJ P,
NMS6B7: TLZE AR1,1 ;SIXBIT CHAR FOUND
JRST NMS6B9 ;IF QUOTED, TAKE AS IS
CAIN A,40
JRST NMS6B8 ;SPACE IS NAME BREAK
CAIE A,":
CAIN A,";
JRST NMS6BZ
NMS6B9: CAIGE A,140 ;LOWER CASE => UPPER
SUBI A,40 ;CONVERT TO SIXBIT
TLNE AR1,770000
IDPB A,AR1
POPJ P,
NMS6BZ: SKIPN D,(AR1) ;ANYTHING THERE?
JRST NMS6BL
CAIN A,":
JRST NMS6BC ;":" => DEVICE NAME
SKIPN -3(AR1) ;";" => SNAME
JSP AR2A,NMS6B5
JRST NMS6BL
NMS6BC: SKIPN -4(AR1)
JSP AR2A,NMS6B5
JRST NMS6BL
SUBTTL CONVERSION: ANY FILE SPEC => SIXBIT
;;; TAKE ARGUMENT IN A (MAY BE FILE ARRAY, NAMELIST,
;;; OR NAMESTRING), FIGURE IT OUT AND SOMEHOW RETURN
;;; FOUR WORDS OF FILE SPECS ON THE FIXNUM PDL.
;;; IFL6BT SAYS THAT T MEANS TTY INPUT, NOT TTY OUTPUT.
;;; SAVES C AR1 AR2A
IFL6BT: CAIN A,TRUTH
HRRZ A,V%TYI
JRST FIL6B0
FIL6BT: CAIN A,TRUTH
HRRZ A,V%TYO
FIL6B0: SKIPN A ;NIL => DEFAULTS
HRRZ A,VDEFAULTF
FIL6B1: MOVEI R,(A)
LSH R,-SEGLOG
SKIPGE R,ST(R)
JRST NML6BT ;LIST => NAMELIST
TLNN R,SA
JRST FIL6B2 ;NOT ARRAY => NAMESTRING
MOVE R,ASAR(A)
TLNN R,AS<JOB+FIL>
JRST NMS6B0 ;INCOMPREHENSIBLE NAMESTRING
MOVEI TT,F.DEV ;GET FILE SPECS FROM ARRAY
PUSH FXP,@TTSAR(A)
10% MOVEI TT,F.SNM
10$ MOVEI TT,F.PPN
PUSH FXP,@TTSAR(A)
MOVEI TT,F.FN1
PUSH FXP,@TTSAR(A)
MOVEI TT,F.FN2
PUSH FXP,@TTSAR(A)
POPJ P,
FIL6B2: JSP T,QIOSAV
JRST NMS6BT
QIOSAV: SAVE B C AR1 AR2A
PUSHJ P,(T)
RSTR AR2A AR1 C B
POPJ P,
SUBTTL MERGING ROUTINES, MERGEF, TRUENAME, PROBEF
;;; MERGEF TAKES TWO FILE SPECS OF ANY KIND, MERGES THEM,
;;; AND RETURNS A NAMELIST OF THE RESULTING SPECS.
;;; AS A CROCK, (MERGEF X '*) SIMPLY MAKES THE SECOND
;;; FILE NAME BE *.
MERGEF: PUSH P,B
PUSHJ P,FIL6BT
POP P,A
CAIE A,Q.
JRST MRGF1
MOVSI T,(SIXBIT \*\)
MOVEM T,(FXP)
JRST 6BTNML
MRGF1: PUSHJ P,FIL6BT
PUSHJ P,IMRGF
JRST 6BTNML
;;; IMRGF MERGES TWO SETS OF SPECS ON THE FIXNUM PDL.
;;; DMRGF MERGES A SET WITH THE DEFAULT FILE NAMES.
;;; DEC-10 PPN'S MERGE HALVES OF THE PPN SEPARATELY;
;;; AN UNSPECIFIED HALF IS ZERO, *NOT* (SIXBIT \*\)!!
;;; SAVES F (SEE LOAD).
DMRGF: PUSH FLP,F ;MERGE WITH DEFAULT FILE NAMES
HRRZ A,VDEFAULTF
PUSHJ P,FIL6BT
POP FLP,F
IMRGF: MOVEI T,4 ;MERGE TWO SETS OF NAMES ON FXP
MOVSI TT,(SIXBIT \*\)
MRGF2:
10$ MOVE R,D
POP FXP,D
SKIPE -3(FXP)
CAMN TT,-3(FXP)
MOVEM D,-3(FXP)
SOJG T,MRGF2
10$ MOVE D,-2(FXP) ;R HAS PPN 2 - GET PPN 1 IN D
10$ TLNN D,-1 ;DEFAULT EACH HALF SEPARATELY
10$ HLLM R,-2(FXP)
10$ TRNN D,-1
10$ HRRM R,-2(D)
POPJ P,
;;; (TRUENAME <FILE>) RETURNS THE RESULT OF .RCHST ON ITS,
;;; I.E. THE REAL FILE NAMES AFTER TRANSLATIONS, LINKS, ETC.
;;; THE RESULT IS A NAMELIST.
TRUENAME:
CAIN A,TRUTH ;SUBR 1
HRRZ A,V%TYO
EXCH AR1,A
PUSHJ P,FILOK
EXCH AR1,A
POP FXP,T ;BEWARE! FILOK DID A LOCKI!
REPEAT 4, PUSH FXP,F.RDEV+.RPCNT(TT)
PUSH FXP,T
UNLOCKI
JRST 6BTNML
;;; (STATUS UREAD)
SUREAD: SKIPN A,VUREAD
POPJ P,
PUSHJ P,TRUENAME
HLRZ B,(A)
HRRZ A,(A)
HRRZ C,(A)
HRRM B,(C)
POPJ P,
;;; (STATUS UWRITE)
SUWRITE: SKIPE A,VUWRITE
PUSHJ P,TRUENAME
JRST $CAR ;(CAR NIL) => NIL
;;; ROUTINE TO SET UP ARGS FOR TWO-ARGUMENT FILE FUNCTION.
;;; PUT TWO SETS OF FILE NAMES ON FXP. IF THE ARGS ARE
;;; X AND Y, THEN THE NAME ON FXP ARE (MERGEF X NIL) AND
;;; (MERGEF Y (MERGEF X NIL)). THE FIRST ARG IS LEFT IN AR1.
2MERGE: PUSH P,A
PUSH P,B
PUSHJ P,FIL6BT
PUSHJ P,DMRGF
POP P,A
PUSHJ P,FIL6BT
REPEAT 4, PUSH FXP,-7(FXP)
PUSHJ P,IMRGF ;NOW WE HAVE THE MERGED FILE SPECS
POP P,AR1 ;FIRST ARG
POPJ P,
;;; (PROBEF X) TRIES TO DECIDE WHETHER FILE X EXISTS.
;;; CURRENTLY THIS IS DONE BY TRYING TO OPEN THE FILE.
;;; RETURNS REAL FILE NAMES ON SUCCESS, NIL ON FAILURE.
PROBEF: PUSHJ P,FIL6BT ;SUBR 1
PROBF0: PUSHJ P,DMRGF
.CALL PROBF8
JRST PROBF6
.CALL PROBF9
.VALUE
.CLOSE TMPC,
JRST 6BTNML
PROBF6: SUB FXP,R70+4
JRST FALSE
PROBF8: SETZ
SIXBIT \OPEN\ ;OPEN FILE (ASCII UNIT INPUT)
1000,,TMPC ;CHANNEL #
,,-3(FXP) ;DEVICE NAME
,,-1(FXP) ;FILE NAME 1
,,0(FXP) ;FILE NAME 2
400000,,-2(FXP) ;SNAME
PROBF9: SETZ
SIXBIT \RFNAME\ ;READ REAL FILE NAMES
1000,,TMPC ;CHANNEL #
2000,,-3(FXP) ;DEVICE NAME
2000,,-1(FXP) ;FILE NAME 1
2000,,0(FXP) ;FILE NAME 2
402000,,-2(FXP) ;SNAME
SUBTTL RENAME FUNCTION
;;; (RENAME X Y) RENAMES (MERGEF X (NAMELIST NIL)) TO BE
;;; (MERGEF Y (MERGEF X (NAMELIST NIL))). MUST BE CAREFUL
;;; IF X IS AN OUTPUT FILE ARRAY - MUST USE A RENAME-WHILE-OPEN.
$RENAME: PUSHJ P,2MERGE
JSP TT,XFILEP ;SKIP IF FILE ARRAY
JRST RENAM2
MOVE TT,TTSAR(AR1)
TLNE TT,TTS<CL>
JRST RENAM2
MOVEI TT,F.CHAN ;OPEN OUTPUT FILE
HLLOS NOQUIT
.CALL RENAM7 ;MUST RENAME WHILE OPEN
IOJRST 0,RENAM6
MOVE TT,TTSAR(AR1)
MOVE T,-1(FXP) ;UPDATE THE FILE NAMES
MOVEM T,F.FN1(TT)
MOVE T,(FXP)
MOVEM T,F.FN2(TT)
.CALL RFNAME ;READ BACK THE TRUENAMES
.VALUE
PUSHJ P,CZECHI
SUB FXP,R70+4
MOVEI A,(AR1)
RENAM1: SUB FXP,R70+4 ; WITH NEW NAMES
POPJ P,
RENAM2: POP P,AR1
.CALL RENAM8 ;ORDINARY RENAME
IOJRST 0,RENAM9
RENAM3: PUSHJ P,6BTNML ;RETURN VALUE IS NAMELIST
JRST RENAM1
RENAM7: SETZ
SIXBIT \RENMWO\ ;RENAME WHILE OPEN
,,@TTSAR(AR1) ;CHANNEL #
,,-1(FXP) ;NEW FILE NAME 1
400000,,(FXP) ;NEW FILE NAME 2
RENAM8: SETZ
SIXBIT \RENAME\ ;RENAME
,,-7(FXP) ;DEVICE NAME
,,-5(FXP) ;OLD FILE NAME 1
,,-4(FXP) ;OLD FILE NAME 2
,,-6(FXP) ;SNAME
,,-1(FXP) ;NEW FILE NAME 1
400000,,(FXP) ;NEW FILE NAME 2
RENAM6: PUSHJ P,CZECHI
RENAM9: MOVEI A,Q$RENAME
RENAM5: PUSH P,A ;ERROR MESSAGE IN C
PUSHJ P,6BTNML
PUSHJ P,NCONS
PUSH P,A
PUSHJ P,6BTNML
POP P,B
PUSHJ P,CONS
POP P,B
XCIOL: PUSHJ P,XCONS ;XCONS, THEN IOL
%IOL (C)
RFNAME: SETZ
SIXBIT \RFNAME\ ;READ FILE NAMES
,,F.CHAN(TT) ;CHANNEL #
2000,,F.RDEV(TT) ;DEVICE NAME
2000,,F.RFN1(TT) ;FILE NAME 1
2000,,F.RFN2(TT) ;FILE NAME 2
402000,,F.RSNM(TT) ;SNAME
SUBTTL DELETEF AND CLOSE FUNCTIONS
;;; (DELETEF X) DELETES THE FILE X. (THAT SOUNDS LOGICAL...)
$DELETEF: PUSHJ P,FIL6BT ;SUBR 1
PUSHJ P,DMRGF ;MERGE ARG WITH DEFAULTS
.CALL $DEL7
IOJRST 0,$DEL9
JRST 6BTNML
$DEL7: SETZ
SIXBIT \DELETE\ ;DELETE FILE
,,-3(FXP) ;DEVICE NAME
,,-1(FXP) ;FILE NAME 1
,,0(FXP) ;FILE NAME 2
400000,,-2(FXP) ;SNAME
$DEL9: PUSHJ P,6BTNML
PUSHJ P,ACONS
MOVEI B,Q$DELETEF
JRST XCIOL
;;; (CLOSE X) CLOSES THE FILE ARRAY X. THE ARRAY ITSELF
;;; IS *NOT* FLUSHED - MAY WANT TO RE-OPEN IT.
CLOSE0: WTA [NOT FILE - CLOSE!]
$CLOSE: SKOTT A,SA
JRST CLOSE0
MOVE TT,ASAR(A)
TLNN TT,AS.FIL
JRST CLOSE0
ICLOSE: HLLOS NOQUIT
MOVE TT,TTSAR(A)
TLNE TT,TTS<CL> ;SKIP UNLESS ALREADY CLOSED
JRA A,CZECHI ;CROCK TO PUT NIL IN A AND JRST
TLNE TT,TTS<IO> ;SKIP UNLESS OUTPUT FILE ARRAY
PUSHJ P,IFORCE ;FORCE OUTPUT BUFFER
MOVE TT,TTSAR(A)
TLNE TT,TTS<TY>
SKIPN T,FT.CNS(TT)
JRST CLOSE4
SETZM FT.CNS(TT) ;UNLINK TWO TTY'S WHICH
MOVE T,TTSAR(T) ; WERE TTYCONS'D TOGETHER
SETZM FT.CNS(T) ; IF ONE IS CLOSED
CLOSE4: HRRZ T,F.CHAN(TT)
MOVSI D,TTS<CL> ;TURN ON "FILE CLOSED"
IORM D,TTSAR(A) ; BIT IN ARRAY SAR
SETZM CHNTB(T) ;CLEAR CHANNEL TABLE ENTRY
.CALL CLOSE9 ;CLOSE FILE
.VALUE
MOVEI A,TRUTH
JRST CZECHI
CLOSE9: SETZ
SIXBIT \CLOSE\ ;CLOSE CHANNEL
401000,,(T) ;CHANNEL #
SUBTTL FORCE-OUTPUT
;;; (FORCE-OUTPUT X) FORCES THE OUTPUT BUFFER OF OUTPUT FILE ARRAY X.
FORCE: PUSH P,AR1
MOVEI AR1,(A)
PUSHJ P,FORCE1
POP P,AR1
POPJ P,
FORCE1: PUSHJ P,OFILOK ;DOES A LOCKI
PUSHJ P,IFORCE
JRST UNLKTRUE
;;; INTERNAL OUTPUT BUFFER FORCE ROUTINE. EXPECTS USER
;;; INTERRUPTS OFF, AND FILE ARRAY TTSAR IN TT.
;;; CLOBBERS T, TT, D, AND F.
IFORCE: TLNE TT,TTS<CL>
LERR [SIXBIT \CAN'T FORCE OUTPUT ON CLOSED FILE!\]
SKIPGE F,F.MODE(TT) .SEE FBT.CM ;CAN'T FORCE A CHARMODE FILE
POPJ P,
TLNE TT,TTS<BN>
JRST FORCE4
TLNE F,FBT.SI
JRST FORCE7
MOVE D,AB.BP(TT) ;PAD ASCII BLOCK FILES WITH ↑C'S
SKIPA T,R70+↑C
FORCE2: IDPB T,D
MOVE F,D ;THIS PIECE OF HAIR WORKS
IBP F ; FOR ANY BYTE SIZE, UNLIKE TE
TLZ F,-1 ; USUAL TLNN 760000 HACK
CAIN F,(D)
JRST FORCE2
MOVEI T,FB.BUF-1(TT) ;CALCULATE # OF WORDS TO OUTPUT
FORCE3: SUB T,AB.BP(TT) .SEE XB.AOB
HRREI F,(T)
MOVN F,F
MOVSI T,(T)
HRRI T,FB.BUF(TT)
.CALL IOTTTT ;OUTPUT THEM, ALREADY
.VALUE
TLNE TT,TTS<BN>
JRST FORCE5
JSP D,FORCE6 ;RESET BUFFER PARAMETERS
SKIPGE F.FPOS(TT) ;THAT'S ALL IF NOT RANDOM ACCESS
POPJ P,
ADDB F,F.FPOS(TT) ;UPDATE ACCESS COUNTER
MOVE D,T ;WAS ANY PADDING USED?
IBP D
TLZ D,-1
CAIE D,(T)
POPJ P,
SUB F,FB.BFL(TT) ;IF SO, JUGGLE BUFFER SO THAT
.CALL ACCESS ; WORD WITH PADDING WILL BE
.VALUE ; REWRITTEN FOR NEXT IOT WITH
MOVE D,(T) ; NEW CHARS INSTEAD OF ↑C'S
MOVEM D,FB.BUF(TT)
HLLM T,AB.BP(TT)
POPJ P,
FORCE4: MOVEI T,FB.BUF(TT)
JRST FORCE3
FORCE5: MOVE T,FB.IOT(TT) ;FOR BINARY FILE, UPDATE
MOVEM T,XB.AOB(TT) ; AOBJN POINTER
SKIPL F.FPOS(TT) ;IF RANDOM ACCESS,
ADDM F,F.FPOS(TT) ; UPDATE ACCESS COUNT
POPJ P,
FORCE6: MOVE T,FB.BFL(TT) ;RESET COUNTER FOR ASCII FILE
IMULI T,@FB.BYT(TT)
MOVEM T,AB.CNT(TT)
MOVEI T,FB.BUF-1(TT) ;RESET BYTE POINTER
HLL T,FB.BYT(TT)
EXCH T,AB.BP(TT) ;LEAVE OLD BYTE POINTER IN T
JRST (D)
FORCE7: MOVE F,FB.BFL(TT) ;FOR FILES WHICH USE SIOT
IMULI F,@FB.BYT(TT)
SUB F,AB.CNT(TT)
MOVE D,F
HRRI T,FB.BUF-1(TT)
HLL T,FB.BYT(TT)
.CALL SIOT
.VALUE
SKIPL F.FPOS(TT)
ADDM F,F.FPOS(TT)
JSP D,FORCE6
POPJ P,
IOTTTT: SETZ
SIXBIT \IOT\ ;I/O TRANSFER
,,F.CHAN(TT) ;CHANNEL #
400000,,T ;DATA POINTER (DATA?)
SIOT: SETZ
SIXBIT \SIOT\ ;STRING I/O TRANSFER
,,F.CHAN(TT) ;CHANNEL #
,,T ;BYTE POINTER
400000,,D ;BYTE COUNT
SUBTTL STATUS FILEMODE
;;; (STATUS FILEMODE <FILE> ) RETURNS A LIST DESCRIBING
;;; THE FILE: NIL ==> FILE HAS BEEN CLOSED; OTHERWISE
;;; THE CAR OF THIS LIST IS A VALID OPTIONS
;;; LIST FOR THE OPEN FUNCTION. THE CDR OF THIS LIST
;;; CONTAINS INFORMATIVE ITEMS WHICH ARE NOT NECESSARILY
;;; USER-SETTABLE FEATURES ABOT THE FILE.
;;; NON-FILE ARGUMENT CAUSES AN ERROR.
;;; PRESENTLY SUCH GOODIES INCLUDE:
;;; RUBOUT AN OUTPUT TTY THAT CAN SELECTIVELY ERASE
;;; CURSORPOS AN OUTPUT TTY THAT CAN CURSORPOS WELL
;;; SAIL FOR AN OUTPUT TTY, HAS SAIL CHARACTER SET
;;; FILEPOS CAN FILEPOS CORRECTLY (RANDOM ACCESS)
SFMD0: %WTA NFILE
SFILEMODE:
JSP TT,AFILEP
JRST SFMD0
LOCKI
MOVE TT,TTSAR(A)
TLNE TT,TTS<CL>
JRST UNLKFALSE
MOVE R,F.FPOS(TT)
MOVEI A,QBLOCK
SKIPGE F,F.MODE(TT) .SEE FBT.CM
MOVEI A,QSINGLE
UNLOCKI
PUSHJ P,NCONS
MOVEI B,QDSK
TLNE TT,TTS<TY>
MOVEI B,QTTY
PUSHJ P,XCONS
MOVEI B,Q$ASCII
TLNE TT,TTS<IM>
MOVEI B,QIMAGE
TLNN TT,TTS<IO>
TLNN TT,TTS<TY>
JRST SFMD1
TLNE F,FBT<FU>
SFMD1: TLNE TT,TTS<BN>
MOVEI B,QFIXNUM
PUSHJ P,XCONS
MOVEI B,Q$IN
TLNE TT,TTS<IO>
MOVEI B,Q$OUT
TLNE F,FBT<AP>
MOVEI B,QAPPEND
PUSHJ P,XCONS
MOVEI B,QECHO
TLNE F,FBT<EC>
PUSHJ P,XCONS
MOVEI C,(A)
SETZ A,
MOVEI B,QSAIL
TLNE F,FBT<SA>
PUSHJ P,XCONS
MOVEI B,QRUBOUT
TLNE F,FBT<SE>
PUSHJ P,XCONS
MOVEI B,QCURSORPOS
TLNE F,FBT<CP>
PUSHJ P,XCONS
MOVEI B,QFILEPOS
TLNE TT,TTS<IO> ;OUTPUT FILEPOS NOT IMPLEMENTED
SETO R,
SKIPL R
PUSHJ P,XCONS
MOVEI B,(C)
JRST XCONS
SUBTTL LOAD FUNCTION
;;; (LOAD FOO) LOADS THE FILE FOO. IT FIRST PROBEF'S TO
;;; ASCERTAIN THE EXISTENCE OF THE FILE, AND CHECKS THE FIRST
;;; WORD TO SEE WHETHER IT IS AN ASCII OR FASL FILE.
;;; IF NO SECOND FILE NAME IS GIVEN, "FASL" IS TRIED FIRST,
;;; AND THEN ">" IF NO FASL FILE EXISTS.
;;; IF A FASL FILE, IT GIVES THE FILE NAMES TO FASLOAD.
;;; IF AN ASCII FILE, IT IS OPENED, (INFILE ↑Q, *, +, -, INSTACK)
;;; BOUND TO (<THE FILE>, T, *, +, -, NIL), AND A READ-EVAL
;;; LOOP PERFORMED UNTIL END OF FILE OCCURS LEAVING INSTACK=NIL
;;; AND INFILE=T.
LOAD: PUSHJ P,FIL6BT ;SUBR 1
MOVE F,(FXP)
PUSHJ P,DMRGF ;DMRGF SAVES F
LOCKI
TLC F,(SIXBIT \*\)
JUMPN F,LOAD3
MOVE TT,[SIXBIT \FASL\]
MOVEM TT,-1(FXP)
JSP T,FASLP1
JRST LOAD1 ;FILE NOT FOUND
JRST LOAD2 ;FASL FILE
LOAD5: UNLOCKI ;EXPR FILE FOUND
PUSHJ P,6BTNML
PUSH P,[LOAD6]
PUSH P,A
MOVNI T,1
JRST $OPEN ;OPEN AS A FILE OBJECT
LOAD6: HRRZ B,VIPLUS ;WE WANT +, -, * TO WORK AS FOR TOP LEVEL,
HRRZ C,V. ; BUT NOT SCREW THE OUTSIDE WORLD
HRRZ AR1,VIDIFFERENCE
MOVEI AR2A,TRUTH
JSP T,SPECBIND
0 A,VINFILE
0 B,VIPLUS
0 C,V.
0 AR1,VIDIFFERENCE
0 AR2A,TAPRED
VINSTACK
JRST LOAD7A
LOAD7: PUSHJ P,LISP1A ;USE THE EVAL PART OF THE TOP LEVEL
HRRZM A,V.
LOAD7A:
REPEAT 2, PUSH P,[LOAD8] ;ONCE FOR RANDOM EOF VALUE
MOVNI T,1
JRST IREAD1
LOAD8: CAIE A,LOAD8
JRST LOAD7
HRRZ B,VINFILE
SKIPN VINSTACK
CAIE B,TRUTH
JRST LOAD7A
PUSHJ P,UNBIND
JRST TRUE
LOAD1: MOVEI A,QLOAD
JUMPN F,LOAD4 ;IF SECOND FILE NAME WAS GIVEN, WE HAVE LOST
MOVSI TT,(SIXBIT \>\) ;OTHERWISE TRY ">"
MOVEM TT,-1(FXP)
LOAD3: JSP T,FASLP1
JRST LOAD4 ;LOSE COMPLETELY
JRST LOAD2 ;FASL FILE
JRST LOAD5 ;EXPR CODE
LOAD2: UNLOCKI ;FASL FILE - GO FASLOAD IT
PUSHJ P,6BTNML
JRST FASLOAD
.CALL FASLP9 ;PURELY TO FAKE OUT IOJRST
LOAD4: IOJRST 0,.+1
PUSH P,A
UNLOCKI
PUSHJ P,6BTNML ;LOSEY LOSEY
PUSHJ P,NCONS
POP P,B
JRST XCIOL
IFN QIO,[
;;; (FASLP <FILE>) TELLS WHETHER THE FILE IS A FASL FILE.
;;; ERROR IF FILE DOES NOT EXIST.
$FASLP: PUSHJ P,FIL6BT
PUSHJ P,DMRGF
MOVE A,Q$FASLP
LOCKI
JSP T,FASLP1
JRST LOAD4
SKIPA A,[TRUTH]
MOVEI A,NIL
UNLOCKI
SUB FXP,R70+4
POPJ P,
;;; ROUTINE TO TEST A FILE FOR FASL-NESS.
;;; JSP T,FASLP1
;;; JRST NOTFOUND ;FILE NOT FOUND, OR OTHER ERROR
;;; JRST FASL ;FILE IS A FASL FILE
;;; ... ;FILE IS NOT A FASL FILE
;;; FXP MUST HOLD THE FOUR FILE NAMES, WITH A LOCKI WORD ABOVE THEM.
FASLP1: .CALL FASLP9
JRST (T)
.IOT TMPC,TT
.CLOSE TMPC,
TRZ TT,1
CAMN TT,[SIXBIT \*FASL*\]
JRST 1(T)
JRST 2(T)
FASLP9: SETZ
SIXBIT \OPEN\ ;OPEN FILE
5000,,4 ;IMAGE UNIT INPUT
1000,,TMPC ;CHANNEL NUMBER
,,-4(FXP) ;DEVICE NAME
,,-2(FXP) ;FILE NAME 1
,,-1(FXP) ;FILE NAME 2
400000,,-3(FXP) ;SNAME
] ;END OF IFN QIO
SUBTTL OPEN FUNCTION
;;; (OPEN <FILE> <MODELIST>) OPENS A FILE AND RETURNS A
;;; CORRESPONDING FILE OBJECT. IT IS ACTUALLY AN LSUBR
;;; OF ZERO TO TWO ARGUMENTS. THE <FILE> DEFAULTS TO THE
;;; CURRENT DEFAULT FILE NAMES. THE <MODELIST> DEFAULTS
;;; TO NIL.
;;; IF <FILE> IS A NAMELIST OR NAMESTRING, A NEW FILE ARRAY
;;; IS CREATED. IF <FILE> IS A FILE ARRAY ALREADY, IT IS
;;; CLOSED AND RE-OPENED IN THE SPECIFIED MODE; ITS FORMER
;;; MODES SERVE AS THE DEFAULTS FOR THE <MODELIST>.
;;; THE <MODELIST> DETERMINES A LARGE NUMBER OF ATTRIBUTES
;;; FOR OPENING THE FILE. FOR EACH ATTRIBUTE THERE ARE
;;; TWO OR MORE MUTUALLY EXCLUSIVE VALUES WHICH MAY BE
;;; SPECIFIED AS FOLLOWS. VALUES MARKED BY A * ARE THOSE
;;; USED AS DEFAULTS WHEN THE <FILE> IS A NAMELIST OR
;;; NAMESTRING. IF THE <MODELIST> IS AN ATOM, IT IS THE
;;; SAME AS SPECIFYING THE LIST OF THAT ONE ATOM.
;;; DIRECTION:
;;; * IN INPUT FILE
;;; * READ SAME AS "IN"
;;; OUT OUTPUT FILE
;;; PRINT SAME AS "OUT"
;;; APPEND OUTPUT, APPENDED TO EXISTING FILE
;;; DATA MODE:
;;; * ASCII FILE IS A STREAM OF ASCII CHARACTERS.
;;; SYSTEM-DEPENDENT TRANSFORMATIONS MAY
;;; OCCUR, SUCH AS SUPPLYING LF AFTER CR,
;;; OR BEING CAREFUL WITH OUTPUT OF ↑P,
;;; OR MULTICS ESCAPE CONVENTIONS.
;;; FIXNUM FILE IS A STREAM OF FIXNUMS. THIS
;;; IS FOR DEALING WITH FILES THOUGHT OF
;;; AS "BINARY" RATHER THAN "CHARACTER".
;;; IMAGE FILE IS A STREAM OF ASCII CHARACTERS.
;;; ABSOLUTELY NO TRANSFORMATIONS ARE MADE.
;;; DEVICE TYPE:
;;; * DSK STANDARD KIND OF FILE.
;;; CLA LIKE DSK, BUT REQUIRES BLOCK MODE, AND
;;; GOBBLES THE FIRST TWO WORDS, INSTALLING
;;; THEM IN THE TRUENAME. USEFUL IN CLI-MESSAGE
;;; INTERRUPT FUNCTION.
;;; TTY CONSOLE. IN PARTICULAR, ONLY TTY INPUT
;;; FILES HAVE INTERRUPT CHARACTER FUNCTIONS
;;; ASSOCIATED WITH THEM.
;;; BUFFERING MODE:
;;; * BLOCK DATA IS BUFFERED.
;;; SINGLE DATA IS UNBUFFERED.
;;; PRINTING AREA:
;;; ECHO OPEN TTY IN ECHO AREA (ITS ONLY)
;;; SOME OF THESE VALUES ARE OF COURSE SYSTEM-DEPENDENT.
;;; YOUR LOCAL LISP SYSTEM WILL ATTEMPT TO DO THE RIGHT THING,
;;; HOWEVER, IN ANY CASE.
;;; IF THE OPTIONS LIST IS INVALID IN ANY WAY, OPEN MAY EITHER
;;; GIVE A WRNG-TYPE-ARGS ERROR, OR BLITHELY ASSUME A CORRECTED
;;; VALUE FOR AN ATTRIBUTE. IN GENERAL, ERRORS SHOULD OCCUR
;;; ONLY FOR TRULY CONFLICTING SPECIFICATIONS. ON THE OTHER
;;; HAND, SPECIFYING BLOCK MODE FOR A DEVICE THAT THE SYSTEM
;;; WANTS TO HANDLE ONLY IN CHARACTER MODE SHOULD JUST GO AHEAD
;;; AND USE CHARACTER MODE.
INCLUDE: HLRZ A,(A) ;FSUBR
PUSH P,[INPUSH] ;(DEFUN INCLUDE FEXPR (X)
PUSH P,A ; (INPUSH (OPEN (CAR X))))
MOVNI T,1
$OPEN: MOVEI D,Q$OPEN ;LSUBR (0 . 2)
CAMGE T,XC-2
JRST WNALOSE
SETZB A,B
CAMN T,XC-2
POP P,B
SKIPE T
POP P,A
OPEN0J: PUSH P,T ;SAVE NUMBER OF ARGS ON P (NOT FXP!)
SETZB D,F
JSP TT,AFILEP
JRST OPEN1A
MOVEI TT,F.MODE
MOVE F,@TTSAR(A)
SKIPE B
TLZ F,FBT<EC> ;MAKE CHUCK RICH HAPPY
OPEN1A: JUMPE B,OPEN1Y
MOVEI C,(B)
MOVEI TT,(B)
LSH TT,-SEGLOG
SKIPG ST(TT)
JRST OPEN1C
MOVSI AR2A,(B)
MOVEI C,AR2A
OPEN1C: JUMPE C,OPEN1L
HLRZ AR1,(C)
MOVSI TT,-LOPMDS
OPEN1F: HRRZ R,OPMDS(TT)
CAIN AR1,(R)
JRST OPEN1K
AOBJN TT,OPEN1F
OPEN1G: HRRZ C,(C)
JRST OPEN1C
OPMDS: FBT<AP>+1,,Q$IN
FBT<AP>+1,,QOREAD
FBT<AP>+1,,Q$OUT
FBT<AP>+1,,Q%PRINT
FBT<AP>+1,,QAPPEND
000014,,Q$ASCII
000014,,QFIXNUM
000014,,QIMAGE
000002,,QDSK
FBT<CA>+2,,QCLA
000002,,QTTY
FBT<CM>,,QBLOCK
FBT<CM>,,QSINGLE
FBT<EC>,,QECHO
LOPMDS==.-OPMDS
OPBITS: 0 ;IN
0 ;READ
1 ;OUT
1 ;PRINT
FBT<AP>,,1 ;APPEND
0 ;ASCII
4 ;FIXNUM
10 ;IMAGE
0 ;DSK
FBT<CA>,,0 ;CLA
2 ;TTY
0 ;BLOCK
FBT<CM>,, ;SINGLE
FBT<EC>,, ;ECHO
IFN .-OPBITS-LOPMDS, .ERR WRONG LENGTH TABLE
OPEN1K: TDNN D,OPMDS(TT)
JRST OPEN1Z
OPEN1H: EXCH A,B
WTA [ILLEGAL OPTIONS LIST - OPEN!]
EXCH A,B
JRST OPEN0J
OPEN1Z: HLRZ R,OPMDS(TT)
TLO D,(R)
TLZ F,(R)
TRZ F,(R)
IOR F,OPBITS(TT)
JRST OPEN1G
;STATE OF THE WORLD:
; FIRST ARG TO OPEN IN A
; SECOND ARG IN B
; D CONTAINS BITS FOR ACTUALLY SPECIFIED OPTIONS
; IN LEFT HALF
; F CONTAINS BITS FOR OPTIONS:
; 4.9 FBT.CM 0 => BLOCK, 1 => SINGLE
; 4.5 FBT.AP 1 => APPEND
; 4.4 FBT.EC 1 => ECHO MODE OUTPUT TTY
; 2.9-2.4 WILL SOON CONTAIN HIGH SIX BITS FOR
; BYTE POINTER IF IN APPEND MODE
; 1.4-1.3 0 => ASCII, 1 => FIXNUM, 2 => IMAGE
; 1.2 0 => DSK, 1 => TTY
; 1.1 0 => IN, 1 => OUT
; ACTUAL NUMBER OF ARGS ON P
OPEN1L: TLNE D,FBT<CM>
JRST OPEN1Y
TRNE F,2 ;FOR TTY, DEFAULT TO SINGLE,
TLO F,FBT<CM> ; NOT BLOCK, MODE
OPEN1Y: TRC F,3
TRCE F,3
JRST OPEN1W
TLNN F,FBT<CM>
TLO F,FBT<SI> ;BUFFERED TTY OUTPUT USES SIOT
JRST OPEN1X
OPEN1W: TLZ F,FBT<EC> ;ECHO IS MEANINGFUL ONLY FOR TTY OUTPUT
OPEN1X: TRNN F,2 ;SKIP IF TTY
JRST OPEN1S
TLZ F,FBT<AP> ;CAN'T APPEND TO A TTY
TRNN F,1
TLO F,FBT<CM> ;CAN'T DO BLOCK TTY INPUT
TRNE F,4 ;FIXNUM TTY I/O USES FULL CAR SET
TLO F,FBT<FU>
OPEN1S: PUSH P,A
PUSH P,B
PUSH FXP,F
CAIE A,TRUTH ;T MEANS TTY FILE ARRAY:
JRST OPEN1M
TRNN F,1
SKIPA A,V%TYI ;TTY INPUT IF MODE BITS SAY INPUT
HRRZ A,V%TYO ; AND OUTPUT OTHERWISE
OPEN1M: PUSH P,A
PUSHJ P,FIL6BT ;GET FILE NAME SPECS
PUSHJ P,DMRGF ;MERGE IN DEFAULT NAMES
MOVE A,(P) ;GET (POSSIBLY MUNGED FOR T) FIRST ARG
JSP TT,AFILEP ;SKIP IF WE GOT A REAL LIVE SAR
JRST OPEN1N
PUSHJ P,ICLOSE ;CLOSE IT IF NECESSARY
MOVE A,(P)
MOVE D,-3(P) ;IF ONLY ONE ARG TO OPEN, AND
AOJE D,OPEN1Q ; THAT A SAR, RE-USE THE ARRAY
MOVE F,-4(FXP)
MOVEI TT,F.MODE
CAME F,@TTSAR(A)
JRST OPEN1P
PUSHJ P,OPNCLR ;IF TWO ARGS, BUT SAME MODE,
JRST OPEN1Q ; CLEAR ARRAY, THAN RE-USE
OPEN1N: MOVSI A,-1
OPEN1P: MOVE F,-4(FXP)
HLRZ TT,OPEN9A(F)
SKIPGE F
HRRZ TT,OPEN9A(F)
PUSHJ P,MKLSAR
OPEN1Q: LOCKI
;STATE OF THE WORLD:
; USER INTERRUPTS LOCKED OUT
; SAR FOR FILE ARRAY IN A
; P: FIRST ARG, OR TTY SAR IF ARG WAS T
; SECOND ARG TO OPEN
; FIRST ARG
; (NEGATIVE OF) ACTUAL NUMBER OF ARGS
; FXP: LOCKI WORD
; FILE NAME 2
; FILE NAME 1
; SNAME
; DEVICE NAME
; MODE BITS
MOVEI TT,-1
SETZM @TTSAR(A)
MOVE F,-5(FXP) ;GET MODE BITS
HLLZ TT,OPEN9B(F)
IORM TT,TTSAR(A) ;SET CLOSED BIT AND FILE TYPE BITS
MOVSI TT,AS<FIL>
IORB TT,ASAR(A) ;NOW CAN TURN ON FILE ARRAY BIT
MOVEI T,-F.GC
HRLM T,-1(TT) ;SET UP GC AOBJN POINTER
MOVEM A,(P) ;SAVE THE FILE ARRAY SAR
PUSHJ P,ALCHAN ;ALLOCATE A CHANNEL
JRST OPNALZ
MOVE TT,TTSAR(A)
HRRZM F,F.CHAN(TT)
POP FXP,T ;BEWARE THE LOCKI WORD!
POP FXP,F.FN2(TT)
POP FXP,F.FN1(TT)
10% POP FXP,F.SNM(TT)
10$ POP FXP,F.PPN(TT)
POP FXP,F.DEV(TT)
EXCH T,(FXP)
PUSH FXP,T
PUSH FXP,XC-1 ;WILL BECOME NON-NEG FOR RANDOM ACCESS
;STATE OF THE WORLD:
; USER INTERRUPTS LOCKED OUT
; TTSAR OF FILE ARRAY IN TT
; MODE BITS IN T
; P: SAR FOR FILE ARRAY
; SECOND ARG TO OPEN
; FIRST ARG
; -<# OF ACTUAL ARGS>
; FXP: -1 ;RANDOM ACCESS FLAG
; MODE BITS
; LOCKI WORD
;PDLS MUST STAY THIS WAY FROM NOW ON FOR THE SAKE OF IOJRST'S.
TLNN T,FBT<AP> ;SKIP IF APPENDING
JRST OPEN3
HLRZ D,OPEN9C-1(T) ;GET CORRESPONDING READ MODE (?)
SKIPGE T
HRRZ D,OPEN9C-1(T)
.CALL OPENUP
IOJRST 4,OPENLZ
.CALL RCHST
.VALUE
SKIPGE F.FPOS(TT) ;IF NOT RANDOM ACCESS, ASSUME
JRST OPEN3 ; NORMAL OUTPUT INSTEAD OF APPEND
.CALL FILLEN
IOJRST 4,OPENLZ
JUMPE F,OPEN3
SUBI F,1
TRNE T,4 ;FOR FIXNUM, DON'T HACK ↑C STUFF
JRST OPEN2B
OPEN2: .CALL ACCESS ;NOT COMPLETELY GENERAL FOR
.VALUE ; ALL BYTE SIZES **************
HRROI T,FB.BUF(TT)
.CALL IOTTTT
IOJRST 4,OPENLZ
MOVE T,[-5,,1]
MOVE D,FB.BUF(TT)
LSH D,-1
OPEN2A: LSHC D,-7
LSH R,-35
JUMPE R,OPEN2C
CAIE R,↑C
CAIN R,↑L
JRST OPEN2C
DPB T,[140600,,-1(FXP)] ;SAVE SIX BITS FOR BYTE POINTER
OPEN2B: MOVEM F,(FXP)
JRST OPEN3
OPEN2C: ADDI T,6
AOBJN T,OPEN2A
SOJA F,OPEN2
OPENUP: SETZ
SIXBIT \OPEN\ ;OPEN FILE
5000,,(D) ;I/O MODE BITS
,,F.CHAN(TT) ;CHANNEL #
,,F.DEV(TT) ;DEVICE NAME
,,F.FN1(TT) ;FILE NAME 1
,,F.FN2(TT) ;FILE NAME 2
400000,,F.SNM(TT) ;SNAME
FILLEN: SETZ
SIXBIT \FILLEN\ ;GET FILE LENGTH (IN WORDS)
,,F.CHAN(TT) ;CHANNEL #
402000,,F ;PUT RESULT IN F
ACCESS: SETZ
SIXBIT \ACCESS\ ;SET FILE ACCESS POINTER
,,F.CHAN(TT) ;CHANNEL #
400000,,F ;POSITION
RCHST: SETZ
SIXBIT \RCHST\ ;READ CHANNEL STATUS
,,F.CHAN(TT) ;CHANNEL #
2000,,F.RDEV(TT) ;DEVICE NAME
2000,,F.RFN1(TT) ;FILE NAME 1
2000,,F.RFN2(TT) ;FILE NAME 2
2000,,F.RSNM(TT) ;SNAME
402000,,F.FPOS(TT) ;ACCESS POINTER
IFN ITS,[
OPEN9A: ;SIZES FOR FILE ARRAYS: BLOCKMODE,,CHARMODE
IRPC X,,[AXI] ;ASCII/FIXNUM/IMAGE
IRPC Y,,[DT] ;DSK/TTY
IRPC Z,,[IO] ;IN/OUT
X!!Y!!Z!B.SZ,,X!!Y!!Z!C.SZ
TERMIN
TERMIN
TERMIN
OPEN9B: ;<TTSAR BITS>,,<BLOCK MODE BUFFER SIZE>
IRP X,,[A,X,I]J,,[,+BN,+IM] ;ASCII/FIXNUM/IMAGE
IRP Y,,[D,T]K,,[,+TY] ;DSK/TTY
IRP Z,,[I,O]L,,[,+IO] ;IN/OUT
TTS<CL!J!!K!!L>,,X!!Y!!Z!B.BS
TERMIN
TERMIN
TERMIN
;;; RECALL THE MEANINGS OF THE FOLLOWING BITS IN ITS:
;;; 1.3 0 => ASCII, 1 => IMAGE
;;; 1.2 0 => UNIT (CHARACTER) MODE, 1 => BLOCK MODE
;;; 1.1 0 => INPUT, 1 => OUTPUT
OPEN9C: ;ITS I/O MODE BITS: BLOCKMODE,,CHARMODE
2,, 0 ;ASCII DSK INPUT
3,, 1 ;ASCII DSK OUTPUT
0,, 0 ;ASCII TTY INPUT
%TJ<DIS>+1,,%TJ<DIS>+1 ;ASCII TTY OUTPUT (DISPLAY IF POSSIBLE)
6,, 4 ;FIXNUM DSK INPUT
7,, 5 ;FIXNUM DSK OUTPUT
%TI<FUL>+0,,%TI<FUL>+0 ;FIXNUM TTY INPUT (>7 BITS ON IMLACS AND TVS)
%TJ<DIS>+1,,%TJ<DIS>+1 ;FIXNUM TTY OUTPUT
2,, 0 ;IMAGE DSK INPUT
3,, 1 ;IMAGE DSK OUTPUT
0,, 0 ;IMAGE TTY INPUT (SUPER-IMAGE INPUT)
%TJ<SIO>+1,,%TJ<SIO>+1 ;IMAGE TTY OUTPUT (SUPER-IMAGE OUTPUT)
OPEN9D: ;WORD FOR FB.BYT: <LH OF BYTE POINTER>,,<BYTES PER WORD>
010700,,5 ;ASCII DSK INPUT
010700,,5 ;ASCII DSK OUTPUT
0 ;ASCII TTY INPUT (IRRELEVANT)
010700,,5 ;ASCII TTY OUTPUT
0 ;FIXNUM DSK INPUT (IRRELEVANT)
0 ;FIXNUM DSK OUTPUT (IRRELEVANT)
0 ;FIXNUM TTY INPUT (IRRELEVANT)
001400,,3 ;FIXNUM TTY OUTPUT
010700,,5 ;IMAGE DSK INPUT
010700,,5 ;IMAGE DSK OUTPUT
0 ;IMAGE TTY INPUT (IRRELEVANT)
041000,,4 ;IMAGE TTY OUTPUT
] ;END OF IFN ITS
OPEN3: MOVE T,-1(FXP) ;GET MODE BITS
TRZ T,770000 ;CLEAR OUT BYTE POINTER CRAP
MOVEM T,F.MODE(TT) ;SAVE IN FILE ARRAY
HLRZ D,OPEN9C(T)
SKIPGE T
HRRZ D,OPEN9C(T)
TLNE T,FBT<AP> ;APPEND MODE =>
TRO D,100000 ; ITS WRITE-OVER MODE
TLNE T,FBT<EC> ;MAYBE OPEN AN OUTPUT TTY
TRO D,%TJ<PP2> ; IN THE ECHO AREA
.CALL OPENUP
IOJRST 4,OPENLZ
.CALL RFNAME
.VALUE
TLNN T,FBT<CA>
JRST OPEN3H
MOVEI T,F.RFN1(TT) ; WHICH ARE THE SIXBIT FOR THE
HRLI T,-2 ; UNAME-JNAME OF THE SENDER, AND
.CALL IOTTTT ; USE THEM FOR THE TRUENAMES
IOJRST 4,OPENLZ ; OF THE FILE ARRAY.
MOVE T,-1(FXP) ;RESTORE MODE BITS
TRZ T,770000
OPEN3H: TRNN T,1
SKIPA D,DEOFFN ;FOR INPUT, GET THE EOFFN
HRRZ D,DENDPAGEFN ;FOR OUTPUT, THE ENDPAGEFN
MOVEM D,FI.EOF(TT) .SEE FO.EOP
SETZM FI.BBC(TT) .SEE FO.LNL
SETZM FI.BBF(TT) .SEE FO.PGL
HRRZ D,OPEN9B ;***** FOR DEC-10, WILL HAVE
SKIPL T ; TO USE THE DEVSIZ UUO
MOVEM D,FB.BFL(TT) ; TO DETERMINE BUFFER SIZE
JRST @.+1(T)
OPNAI1 ;ASCII DSK INPUT
OPNAO1 ;ASCII DSK OUTPUT
OPNTI1 ;ASCII TTY INPUT
OPNTO1 ;ASCII TTY OUTPUT
OPNBI1 ;FIXNUM DSK INPUT
OPNBO1 ;FIXNUM DSK OUTPUT
OPNTI1 ;FIXNUM TTY INPUT
OPNTO1 ;FIXNUM TTY OUTPUT
OPNAI1 ;IMAGE DSK INPUT
OPNAO1 ;IMAGE DSK OUTPUT
OPNTI1 ;IMAGE TTY INPUT
OPNTO1 ;IMAGE TTY OUTPUT
OPNAO1: MOVE D,DPAGEL ;DEFAULT PAGEL
MOVEM D,FO.PGL(TT)
MOVE D,DLINEL ;DEFAULT LINEL
MOVEM D,FO.LNL(TT)
JUMPL T,OPNA3 .SEE FBT.CM
MOVE D,FB.BFL(TT)
ADDM D,F.FPOS(TT)
OPNAI1:
OPNA6: JUMPL T,OPNA3 .SEE FBT.CM
MOVN D,FB.BFL(TT)
HRLI D,FB.BUF(TT)
MOVSM D,FB.IOT(TT)
MOVE D,OPEN9D(T)
MOVEM D,FB.BYT(TT)
MOVE D,FB.BFL(TT)
IMULI D,@FB.BYT(TT)
TRNN T,1
SETZ D,
MOVEM D,AB.CNT(TT)
HLLZ D,FB.BYT(TT)
JRST OPNA3A
OPNA3: SETZ D,
OPNA3A: SKIPGE F,(FXP)
JRST OPNA2
HRL D,-1(FXP) ;NOT COMPLETELY GENERAL FOR
TLZ D,7777 ; ALL BYTE SIZES ***************
TLO D,0700
.CALL ACCESS
IOJRST 4,OPENLZ
ADDI F,1
ADDM F,F.FPOS(TT)
HRRI D,FPOS3
LDB R,D
HRRI D,1
MOVNI R,(R)
SKIPL T
ADDM R,AB.CNT(TT)
OPNA2: JUMPL T,OPNAT3 .SEE FBT.CM
ADDI D,FB.BUF-1(TT)
TRNN T,1
ADD D,FB.BFL(TT)
MOVEM D,AB.BP(TT)
JRST OPNAT3
OPNTI1: SETZM TI.BFN(TT)
MOVE D,[STTYW1]
MOVEM D,TI.ST1(TT)
MOVE D,[STTYW2]
MOVEM D,TI.ST2(TT)
.CALL TTYGET
IOJRST 4,OPENLZ
;TURN OFF SCROLLING, AUTO-INT, SUPER-IMAGE
TLZ F,%TS<ROL+INT+SII>
TRNE T,10 ;TTY IMAGE INPUT =>
TLO F,%TS<SII> ; ITS SUPER-IMAGE INPUT
.CALL TTYSET
IOJRST 4,OPENLZ
SETZM FT.CNS(TT)
JRST OPNAT3
TTYGET: SETZ
SIXBIT \TTYGET\ ;GET TTYST1, TTYST2, TTYSTS
,,F.CHAN(TT) ;TTY CHANNEL #
2000,,D ;TTYST1
2000,,R ;TTYST2
402000,,F ;TTYSTS
TTYSET: SETZ
SIXBIT \TTYSET\ ;SET TTYST1, TTYST2, TTYSTS
,,F.CHAN(TT) ;TTY CHANNEL #
,,TI.ST1(TT) ;TTYST1
,,TI.ST2(TT) ;TTYST2
400000,,F ;TTYSTS
OPNTO1: .CALL CNSGET
IOJRST 4,OPENLZ
MOVSI R,200000 ;INFINITE PAGEL INITIALLY
MOVEM R,FO.PGL(TT)
SOS FO.LNL(TT)
SETZ R,
TLNE D,%TO<SA1> ;SKIP UNLESS WE HAVE SAIL CHARS
TLO R,FBT<SA> ;SET SAIL BIT
TLNE D,%TO<MVU> ;IF WE CAN MOVE UP, ASSUME WE
TLO R,FBT<CP> ; CAN CURSORPOS IN GENERAL (?)
TLNE D,%TO<ERS> ;REMEMBER THE SELECTIVE ERASE BIT
TLO R,FBT<SE> .SEE RUB1CH
IORB R,F.MODE(TT)
SETZM FT.CNS(TT)
TLNN R,FBT<EC>
JRST OPNA6
.CALL SCML
.VALUE
.CALL TTYGET
.VALUE
TLZ F,%TS<FCO>
TLNE R,FBT<FU>
TLO F,%TS<FCO>
.CALL TTYSAC
.VALUE
JRST OPNA6
SCML: SETZ
SIXBIT \SCML\ ;SET NUMBER OF COMMAND LINES
,,F.CHAN(TT) ;TTY CHANNEL #
401000,,5 ;NUMBER OF LINES
CNSGET: SETZ
SIXBIT \CNSGET\ ;GET CONSOLE PARAMETERS
,,F.CHAN(TT) ;TTY CHANNEL #
2000,,FO.PGL(TT) ;VERTICAL SCREEN SIZE
2000,,FO.LNL(TT) ;HORIZONTAL SCREEN SIZE
2000,,D ;TCTYP (THROW AWAY)
2000,,D ;TTYCOM (THROW AWAY)
402000,,D ;TTYOPT
;TTYTYP NOT GOTTEN
OPNBO1: JUMPL T,OPNB2 .SEE FBT.CM
MOVE D,FB.BFL(TT)
ADDM D,F.FPOS(TT)
OPNBI1: JUMPL T,OPNB2 .SEE FBT.CM
MOVN D,FB.BFL(TT)
HRLI D,FB.BUF(TT)
MOVSM D,FB.IOT(TT)
MOVEI R,FB.BUF(TT)
ADD R,FB.BFL(TT)
TRNN T,1
MOVSI D,(R)
MOVSM D,XB.AOB(TT)
OPNB2: SKIPGE F,(FXP)
JRST OPEN4
.CALL ACCESS
IOJRST 4,OPENLZ
ADDM F,F.FPOS(TT)
JRST OPEN4
OPNAT3: SETZM AT.CHS(TT)
SETZM AT.LNN(TT)
MOVEI D,1
MOVEM D,AT.PGN(TT)
OPEN4: POP P,A ;SAR FOR FILE ARRAY - RETURNED
MOVSI TT,TTS<CL>
ANDCAM TT,TTSAR(A) ;UNCLOSE IT
SUB P,R70+3 ;FLUSH 2 ARGS AND # OF ARGS
SUB FXP,R70+2 ;FLUSH ACCESS FLAG AND MODE BITS
UNLKPOPJ
OPNALZ: MOVEI C,[SIXBIT \ALL I/O CHANNELS ALREADY IN USE!\]
POP FXP,-5(FXP) ;FAKE OUT CORRECT PDL CONDITIONS
SUB FXP,R70+2
OPENLZ: MOVE F,F.CHAN(TT) ;REMEMBER, C HAS ERROR MSG
SETZM CHNTB(F) ;CLOSE CHANNEL AND DEALLOCATE
.CALL ALCHN9
.VALUE
POP P,AR1
POP P,A ;SECOND ARG
POP P,B ;FIRST ARG
POP P,T ;ARG COUNT
JUMPN T,OPNLZ1
MOVEI A,(AR1)
PUSHJ P,NAMELIST
JRST OPNLZ2
OPNLZ1: PUSHJ P,ACONS
EXCH A,B
PUSHJ P,ACONS
CAMN T,XC-2
HRRM B,(A)
OPNLZ2: MOVEI B,Q$OPEN
SUB FXP,R70+2 ;FLUSH 2 FXP WORDS
UNLOCKI
JRST XCIOL
SUBTTL DEFAULTF, ENDPAGEFN, EOFFN
;;; (DEFAULTF X) SETS THE DEFAULT NAMELIST TO X.
;;; X IS MERGEF'D WITH THE OLD NAMELIST FIRST.
;;; IT FOLLOWS THAT (DEFAULTF NIL) = (NAMELIST NIL).
DEFAULTF: PUSHJ P,FIL6BT
PUSHJ P,DMRGF
PUSHJ P,6BTNML
MOVEM A,VDEFAULTF
POPJ P,
SSCRFILE==DEFAULTF
;;; (EOFFN F) GETS INPUT FILE F'S END-OF-FILE FUNCTION.
;;; (EOFFN F X) SETS THE FUNCTION TO BE X.
;;; (ENDPAGEFN F) GETS OUTPUT FILE F'S END-OF-PAGE FUNCTION.
;;; (ENDPAGEFN F X) SETS IT TO BE X.
ENDPAGEFN: JSP TT,LWNACK ;LSUBR (1 . 2)
LA12,,QENDPAGEFN
MOVEI TT,ATOFOK
MOVEI B,DENDPAGEFN
JRST EOFFN0
EOFFN: JSP TT,LWNACK ;LSUBR (1 . 2)
LA12,,QEOFFN
MOVEI TT,IFILOK
MOVEI B,DEOFFN
EOFFN0: AOJN T,EOFFN5
POP P,AR1
JUMPE AR1,EOFFN2
PUSHJ P,(TT)
MOVEI TT,FI.EOF .SEE FO.EOP
HRRZ A,@TTSAR(AR1)
UNLKPOPJ
EOFFN2: HRRZ A,(B)
POPJ P,
EOFFN5: POP P,A
POP P,AR1
JUMPE AR1,EOFFN7
PUSHJ P,(TT)
MOVE TT,TTSAR(AR1)
HRRZM A,FI.EOF(TT) .SEE FO.EOP
UNLKPOPJ
EOFFN7: HRRZM A,(B)
POPJ P,
SUBTTL LISTEN FUNCTION
;;; (LISTEN) LISTENS TO THE CONSOLE.
;;; (LISTEN X) LISTENS TO THE SPECIFIED TTY X.
$LISTEN: SKIPA F,CFIX1 ;LSUBR (0 . 1) NCALLABLE
MOVEI F,CPOPJ
JUMPN T,$LSTN2
.LISTEN TT,
JRST (F)
$LSTN2: MOVEI D,Q$LISTEN
AOJN T,S1WNAL
POP P,AR1 ;FILE ARRAY SPECIFIED
PUSHJ P,TIFLOK ;IT BETTER BE TTY INPUT
.CALL LISTEN ;SO LISTEN ALREADY
SETZ R,
MOVEI TT,FI.BBC
MOVE A,@TTSAR(AR1) ;ALSO COUNT IN ANY BUFFERED
TLZE A,-1 ; UP CHARACTERS PENDING
AOS R
JSP T,LNG1A
ADD TT,R
UNLOCKI
JRST (F)
LISTEN: SETZ
SIXBIT \LISTEN\ ;LISTEN AT A TTY, ALREADY
,,F.CHAN(TT) ;TTY CHANNEL #
402000,,R ;NUMBER OF TYPED-AHEAD CHARS
SUBTTL LINEL, PAGEL, CHARPOS, LINENUM, PAGENUM
;;; VARIOUS FUNCTIONS TO GET AND SET A FILE'S LINEL, PAGEL,
;;; CHARPOS, LINENUM, AND PAGENUM.
LINEL: SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
FO.LNL,,QLINEL
DLINEL,,ATOFOK
PAGEL: SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
FO.PGL,,QPAGEL
DPAGEL,,ATOFOK
CHARPOS: SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
AT.CHS,,QCHARPOS
0,,ATOFOK
LINENUM: SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
AT.LNN,,QLINEL
0,,ATFLOK
PAGENUM: SKIPA D,CFIX1
MOVEI D,CPOPJ
JSP F,FLFROB ;LSUBR (1 . 2)
AT.PGN,,QPAGENUM
0,,ATFLOK
FLFROB: AOJN T,FLFRB5
PUSH P,AR1
MOVE AR1,-1(P)
MOVEM D,-1(P)
JUMPE AR1,FLFRB3
FLFRB1: HRRZ TT,1(F)
PUSHJ P,(TT)
HLRZ TT,(F)
MOVM TT,@TTSAR(AR1) .SEE STERPRI ;LINEL MAY BE NEGATIVE
UNLOCKI
FLFB1A: POP P,AR1
POPJ P,
FLFRB3: HLRZ TT,1(F)
JUMPE TT,FLFRB1
MOVE TT,(TT)
JRST FLFB1A
FLFRB5: POP P,A
JSP T,FXNV1
PUSH P,AR1
MOVE AR1,-1(P)
MOVEM D,-1(P)
MOVE D,TT
JUMPE AR1,FLFRB7
FLFRB6: HRRZ TT,1(F)
PUSHJ P,(TT)
HLRZ TT,(F)
MOVMS D
EXCH D,@TTSAR(AR1)
SKIPGE D
MOVNS @TTSAR(AR1)
UNLOCKI
FLFRB8: MOVE TT,D
JRST FLFB1A
FLFRB7: HLRZ TT,1(F)
JUMPE TT,FLFRB6
MOVMM D,(TT)
JRST FLFRB8
SUBTTL IN
;;; (IN X) INPUTS ONE FIXNUM FROM THE BINARY FILE X AND
;;; RETURNS IT.
$IN: PUSH P,CFIX1 ;SUBR 1 - NCALLABLE
PUSH P,AR1
MOVEI AR1,(A)
PUSHJ P,XIFLOK
SKIPL F.MODE(TT) .SEE FBT.CM
JRST $IN2
MOVE F,F.CHAN(TT)
LSH F,27
IOR F,[.IOT TT]
AOS F.FPOS(TT)
XCT F
$IN1: POP P,AR1
UNLKPOPJ
$IN2: SKIPL T,XB.AOB(TT)
JRST $IN6
MOVE D,(T)
ADD T,R70+1
MOVEM T,XB.AOB(TT)
MOVE TT,D
JRST $IN1
$IN6: MOVE T,FB.IOT(TT)
MOVEM T,XB.AOB(TT)
MOVE F,F.CHAN(TT)
LSH F,27
IOR F,[.IOT T]
MOVE D,FB.BFL(TT)
ADDM D,F.FPOS(TT)
XCT F
JUMPGE T,$IN2
CAMN T,FB.IOT(TT)
JRST $IN7
SUB T,FB.IOT(TT)
MOVNI T,(T)
HRLM T,XB.AOB(TT)
JRST $IN2
$IN7: MOVEI A,(AR1)
HRRZ T,FI.EOF(TT)
SETZM XB.AOB(TT)
UNLOCKI
POP P,AR1
JUMPE T,$IN8
JCALLF 1,(T)
$IN8: PUSH P,B
PUSHJ P,NCONS
MOVEI B,Q$IN
PUSHJ P,XCONS
POP P,B
IOL [EOF - IN!]
SUBTTL OUT
;;; (OUT X N) OUTPUTS THE FIXNUM N TO THE FILE X. RETURNS T.
$OUT: PUSH P,AR1
JSP T,FXNV2
MOVEI AR1,(A) ;SUBR 2
PUSHJ P,XOFLOK
SKIPL F.MODE(TT) .SEE FBT.CM
JRST $OUT4
MOVE F,F.CHAN(TT)
LSH F,27
IOR F,[.IOT D]
AOS F.FPOS(TT)
XCT F
$OUT1: POP P,AR1
JRST UNLKTRUE
$OUT4: MOVE T,XB.AOB(TT)
MOVEM D,(T)
AOBJP T,$OUT7
MOVEM T,XB.AOB(TT)
JRST $OUT1
$OUT7: MOVE T,FB.IOT(TT)
MOVEM T,XB.AOB(TT)
MOVE F,F.CHAN(TT)
LSH F,27
IOR F,[.IOT T]
MOVE D,FB.BFL(TT)
ADDM D,F.FPOS(TT)
XCT F
JRST $OUT1
SUBTTL FILEPOS
;;; FILEPOS FUNCTION
;;; (FILEPOS F) RETURNS CURRENT FILE POSITION
;;; (FILEPOS F N) SETQ FILEPOS TO X
;;; FOR ASCII FILES, THE POSITION IS MEASURED IN CHARACTERS;
;;; FOR FIXNUM FILES, IN FIXNUMS (WORDS). ZERO IS THE
;;; BEGINNING OF THE FILE. ERROR IF FILE IS NOT RANDOMLY
;;; ACCESSIBLE.
;;; ***** SETTING NOT IMPLEMENTED FOR OUTPUT FILES YET *****
FILEPOS:
AOJE T,FPOS1 ;ONE ARG => GET
AOJE T,FPOS5 ;TWO ARGS => SET
MOVEI D,QFILEPOS ;ARGH! ARGH! ARGH! ...
JRST S2WNALOSE
FPOS0B: SKIPA C,FPOS0
FPOS0C: MOVEI C,[SIXBIT \ILLEGAL ACCESS POINTER!\]
MOVEI A,(B)
PUSHJ P,NCONS
JRST FPOS0A
FPOS0: MOVEI C,[SIXBIT \FILE NOT RANDOMLY ACCESSIBLE!\]
SETZ A,
FPOS0A: MOVEI B,(AR1)
PUSHJ P,XCONS
MOVEI B,QFILEPOS
UNLOCKI
JRST XCIOL
FPOS1: POP P,AR1 ;ARG IS FILE
PUSHJ P,FILOK ;DOES LOCKI
SKIPGE D,F.FPOS(TT) ;LOSE IF NOT RANDOMLY ACCESSIBLE
JRST FPOS0
SKIPGE F.MODE(TT) ;SKIP IF BUFFERED
JRST FPOS1A ;ELSE F.FPOS HAS THE RIGHT THING
TLNE TT,TTS<BN>
JRST FPOS4
ADDI D,@AB.BP(TT) ;BUFFERED ASCII
SUBI D,FB.BUF(TT)
SUB D,FB.BFL(TT)
IMULI D,BYTSWD ;MUST GET IN TERMS OF CHARS
MOVEI R,FPOS3
HLL R,AB.BP(TT) ;ADJUST FOR WHICH BYTE
LDB R,R
ADDI D,(R)
FPOS1A: TLNN TT,TTS<IO>
SKIPN B,FI.BBC(TT)
JRST FPOS2
TLZE B,-1 ;ALLOW FOR ANY BUFFERED BACK CHARS
SUBI D,1
FPOS1C: JUMPE B,FPOS2
HRRZ B,(B)
SOJGE D,FPOS1C
SETZ D, ;?? RAN OFF BEGINNING
FPOS2: MOVE TT,D ;RETURN POSITION AS FIXNUM
UNLOCKI
JRST FIX1
FPOS3:
.BYTE 7
1 ? 2 ? 3 ? 4 ? 5 ;MAGIC TABLE
.BYTE
FPOS4: SKIPL R,XB.AOB(TT) ;BUFFERED FIXNUMS
JRST FPOS2
ADDI D,(R)
SUBI D,FB.BUF(TT)
SUB D,FB.BFL(TT)
JRST FPOS2
FPOS5: POP P,B ;SECOND ARG IS FIXNUM
POP P,AR1 ;FIRST IS FILE
JSP T,FXNV2
PUSHJ P,FILOK ;DOES LOCKI
JUMPL D,FPOS0C ;CHECK OUT ACCESS POINTER
.CALL FILLEN ;MUST BE WITHIN FILLEN
JRST FPOS5C ;ASSUME OK (CROCK FOR USR DEVICE)
TLNN TT,TTS<BN>
IMULI F,BYTSWD
CAMLE D,F
JRST FPOS0C
FPOS5C: TLNN TT,TTS<IO> ;*** OUTPUT LOSES ***
SKIPGE F.FPOS(TT) ;ALSO IF NOT RANDOM ACCESS
JRST FPOS0B
TLNE TT,TTS<BN>
JRST FPOS7
SETZM FI.BBC(TT) ;CLEAR OUT BUFFERED BACK CHARS
SETZM FI.BBF(TT) ;CLEAR OUT BUFFERED BACK FORMS
MOVE F,D ;ASCII FILE
IDIVI D,BYTSWD
.CALL FPOS9 ;SET ITS ACCESS POINTER
.VALUE
SKIPGE F.MODE(TT)
JRST FPOS6
MOVEM D,F.FPOS(TT) ;FOR BUFFERED ASCII,
MOVE T,TT ; SET UP THE BUFFER
PUSHJ P,$DEV5K
SETZB R,AB.CNT(T) ;IN CASE OF EOF
JUMPE R,UNLKTRUE
FPOS5A: IBP AB.BP(T) ;ALSO DIDDLE THE BYTE POINTER
SOSGE AB.CNT(T)
.VALUE ;JUST IN CASE!
SOJG R,FPOS5A
JRST UNLKTRUE
FPOS6: MOVEM F,F.FPOS(TT) ;FOR UNIT ASCII,
JUMPE R,UNLKTRUE ; GOBBLE ENOUGH CHARACTERS
FPOS6A: .CALL IOTTTT ; TO POSITION WITHIN THE WORD
.VALUE
SOJG R,FPOS6A
JRST UNLKTRUE
FPOS7: .CALL FPOS9 ;FOR FIXNUMS, SET ITS ACCESS POINTER
.VALUE
MOVEM D,F.FPOS(TT)
SKIPGE F.MODE(TT)
JRST UNLKTRUE
MOVEI D,FB.BUF(TT)
ADD D,FB.BFL(TT)
MOVEM D,XB.AOB(TT)
JRST UNLKTRUE
FPOS9: SETZ
SIXBIT \ACCESS\ ;SET FILE ACCESS POINTER
,,F.CHAN(TT) ;CHANNEL NUMBER
400000,,D ;ACCESS POINTER
SUBTTL CONTROL-P CODES AND TTY INITIALIZATION
;;; PUSH A ↑P CODE INTO A TTY FILE ARRAY IN AR1.
;;; THE CHARACTER TO FOLLOW THE ↑P IS IN D.
;;; IF THE CHARACTER IS "H, "I, OR "V, THEN THE SECOND
;;; CHARACTER IS IN THE LEFT HALF OF D.
;;; CHARPOS, LINENUM, AND PAGEL ARE CORRECTLY UPDATED.
;;; I/O LOSSES DUE TO INTERRUPTS BETWEEN ↑P AND THE
;;; NEXT CHARACTER ARE SCRUPULOUSLY AVOIDED.
;;; CLOBBERS T, TT, D, AND F. SAVES R (SEE RUB1C3).
CNPCOD: .5LKTOPOPJ .SEE INTTYR
HLLOS NOQUIT
MOVE T,TTSAR(AR1)
MOVE TT,F.MODE(T)
TLNN TT,FBT<CP>
JRST CZECHI
PUSH FXP,D
JUMPL TT,CNPCD1 .SEE FBT.CM
MOVE TT,AB.CNT(T)
SUBI TT,3
JUMPGE TT,CNPCD1
MOVE TT,T
PUSHJ P,IFORCE
MOVE T,TTSAR(AR1)
CNPCD1: MOVEI TT,↑P
PUSHJ P,TYOF6
HRRZ TT,(FXP)
PUSHJ P,TYOF6
HLRZ TT,(FXP)
JUMPE TT,CNPCD2
TRZ TT,400000
PUSHJ P,TYOF6
CNPCD2: POP FXP,TT
CAIN TT,135 ;CLOSE BRACKET - NEEDS NO HAIR
JRST CZECHI
JRST CNPC9-"A(TT)
CNPC9: JRST CNP.A ;A ADVANCE TO FRESH LINE
JRST CNP.B ;B MOVE BACK 1, WRAPAROUND
JRST CNP.C ;C CLEAR SCREEN
JRST CNP.D ;D MOVE DOWN, WRAPAROUND
JRST CZECHI ;E CLEAR TO EOF
JRST CNP.F ;F MOVE FORWARD 1, WRAPAROUND
.LOSE
JRST CNP.H ;H SET HORIZONTAL POSITION
JRST CNP.I ;I TREAT NEXT CHARACTER AS ONE-POSITION PRINTING CHAR
.LOSE
JRST CZECHI ;K KILL CHARACTER UNDER CURSOR
JRST CZECHI ;L CLEAR TO END OF LINE
JRST CNP.M ;M GO INTO **MORE** STATE, THEN HOME UP
JRST CZECHI ;N GO INTO **MORE** STATE
.LOSE
.LOSE ;P OUTPUT A ↑P
.LOSE ;Q OUTPUT A ↑C
.LOSE ;R RESTORE CURSOR POSITION
.LOSE ;S SAVE CURSOR POSITION
JRST CNP.T ;T TOP OF SCREEN (HOME UP)
JRST CNP.U ;U MOVE UP, WRAPPING AROUND
JRST CNP.V ;V SET VERTICAL POSITION
.LOSE
JRST CNP.X ;X BACKSPACE AND ERASE ONE CHAR
.LOSE
JRST CNP.Z ;Z HOME DOWN
CNP.X: ;SAME AS ↑P K ↑P B
CNP.B: MOVE D,FO.LNL(T) ;MOVE BACKWARDS
SUBI D,1
SOSGE AT.CHS(T) ;WRAP AROUND IF AT LEFT MARGIN
MOVEM D,AT.CHS(T)
JRST CZECHI
CNP.M: ;DOES **MORE**, THEN HOMES UP
CNP.C: AOS AT.PGN(T) ;CLEAR SCREEN - AOS PAGENUM
CNP.T: SETZM AT.CHS(T) ;HOME UP - ZERO OUT CHARPOS
SETZM AT.LNN(T) ; AND LINENUM
JRST CZECHI
CNP.A: SKIPN AT.CHS(T) ;CRLF, UNLESS AT START OF LINE
JRST CZECHI
SETZM AT.CHS(T) ;CLEAR CHARPOS, THEN INCR LINENUM
CNP.D: AOS D,AT.LNN(T) ;MOVE DOWN
CAML D,FO.PGL(T) ;WRAP AROUND OFF BOTTOM TO TOP
SETZM AT.LNN(T)
JRST CZECHI
CNP.F: AOS D,AT.CHS(T) ;MOVE FORWARD - WRAP AROUND
CAML D,FO.LNL(T) ; OFF END TO LEFT MARGIN
SETZM AT.CHS(T)
JRST CZECHI
CNP.H: HLRZ D,TT ;SET HORIZONTAL POSITION
SUBI D,7
CAMLE D,FO.LNL(T) ;PUT ON RIGHT MARGIN IF TOO BIG
MOVE D,FO.LNL(T)
SUBI D,1
MOVEM D,AT.CHS(T)
JRST CZECHI
CNP.I: AOS AT.CHS(T) ;NOT REALLY THE RIGHT THING, BUT CLOSE
JRST CZECHI
CNP.Z: SETZM AT.LNN(T) ;HOME DOWN (GO UP FROM TOP!)
CNP.U: MOVE D,FO.PGL(T) ;MOVE UP
SUBI D,1 ;WRAP AROUND FROM TOP TO BOTTOM
SOSGE AT.LNN(T)
MOVEM D,AT.LNN(T)
JRST CZECHI
CNP.V: HLRZ D,TT ;SET VERTICAL POSITION
SUBI D,7 ;IF TOO LARGE, PUT ON BOTTOM
CAMLE D,FO.PGL(T)
MOVE D,FO.PGL(T)
SUBI D,1
MOVEM D,AT.LNN(T)
JRST CZECHI
;;; VARIOUS ROUTINES FOR PRINTING ↑P CODES
CNPBBL: MOVEI D,"B
PUSHJ P,CNPCOD
CNPBL: MOVEI D,"B
PUSHJ P,CNPCOD
CNPL: MOVEI D,"L
JRST CNPCOD
CNPU: MOVEI D,"U
JRST CNPCOD
CNPF: MOVEI D,"F
JRST CNPCOD
CLRSRN: MOVEI D,"C
JRST CNPCOD
;;; ROUTINE FOR OPENING UP THE INITIAL TTY FILE ARRAYS.
;;; SKIPS ON SUCCESS (FAILS IF THIS JOB NEVER HAD THE TTY).
OPNTTY: .SUSET [.RTTY,,T] ;GET .TTY USER VARIABLE
TLNE T,%TB<NVR> ;FAIL IF WE NEVER HAD THE TTY
COPNT1: POPJ P,OPNT1
AOS (P)
HRRZ A,V%TYO
MOVEI TT,FO.EOP
PUSH P,@TTSAR(A)
PUSH P,COPNT1 ;OPEN UP TTY OUTPUT ARRAY
PUSH P,A
MOVNI T,1
JRST $OPEN
OPNT1: MOVEI AR1,(A)
POP P,A
MOVEI TT,FO.EOP
MOVEM A,@TTSAR(AR1)
MOVEI TT,FO.LNL
MOVE TT,@TTSAR(AR1)
MOVEM TT,DLINEL ;SET UP DEFAULT LINEL FROM INITIAL JOB CONSOLE
MOVEI TT,FO.PGL
MOVE TT,@TTSAR(AR1)
MOVEM TT,DPAGEL ;SET UP DEFAULT PAGEL "
PUSH P,[OPNT1A]
PUSH P,AR1
MOVNI T,1
JRST STTYTYPE
OPNT1A: MOVEM A,VTTY ;INITIALIZE "TTY" TO (STATUS TTYTYPE)
HRRZ A,V%TYI
MOVEI TT,TI.BFN
PUSH P,@TTSAR(A)
MOVEI TT,TI.ST1
PUSH FXP,@TTSAR(A)
MOVEI TT,TI.ST2
PUSH FXP,@TTSAR(A)
PUSH P,COPNT2 ;OPEN UP TTY INPUT ARRAY
PUSH P,V%TYI
MOVNI T,1
JRST $OPEN
OPNT2: POP FXP,R ;BEWARE THE LOCKI WORD!
POP FXP,D
LOCKI
MOVE TT,TTSAR(A)
MOVEM D,TI.ST1(TT)
MOVEM R,TI.ST2(TT)
.CALL TTY2ST
.VALUE
POP P,TI.BFN(TT)
UNLOCKI
HRRZ A,V%TYI
HRRZ B,V%TYO
PUSHJ P,SSTTYCONS ;CONS THEM TOGETHER AS CONSOLE
COPNT2: POPJ P,OPNT2
SUBTTL CLEAR-INPUT, CLEAR-OUTPUT
;;; (CLEAR-INPUT X) CLEARS ANY PENDING INPUT.
;;; CURREENTLY ONLY EFFECTIVE FOR TTY'S.
CLRIN: PUSH P,AR1
MOVEI AR1,(A)
PUSHJ P,IFILOK
TLNE TT,TTS<TY>
PUSHJ FXP,CLRI3
JRST $OUT1
CLRI3: .CALL CLRIN9 ;RESET TTY INPUT AT ITS LEVEL
.VALUE
SETZM FI.BBC(TT) ;CLEAR BUFFERED-BACK CHARS
SETZM FI.BBF(TT) ;CLEAR BUFFERED-BACK FORMS
POPJ FXP,
CLRIN9: SETZ
SIXBIT \RESET\ ;RESET I/O CHANNEL
400000,,F.CHAN(TT) ;CHANNEL #
;;; (CLEAR-OUTPUT X) CLEARS ANY OUTPUT NOT ACTUALLY ON
;;; THE OUTPUT DEVICE YET. CURRENTLY ONLY EFFECTIVE FOR TTY'S.
CLROUT: PUSH P,AR1
MOVEI AR1,(A)
PUSHJ P,OFILOK
TLNE TT,TTS<TY> ;SKIP IF TTY
PUSHJ FXP,CLRO3
JRST $OUT1
CLRO3: .CALL CLRIN9 ;RESET CHANNEL
.VALUE
.CALL RCPOS1 ;RESET CHARPOS AND LINEL
.VALUE
HLL T,F.MODE(TT)
TLNE T,FBT<EC>
MOVE D,R
HLRZM D,AT.CHS(TT)
HRRZM D,AT.LNN(TT)
TLNN T,FBT<CM> ;IF BLOCK MODE, RESET
JSP D,FORCE6 ; LISP BUFFER POINTERS
POPJ FXP,
RCPOS1: SETZ
SIXBIT \RCPOS\ ;READ CURSOR POSITION
,,F.CHAN(TT) ;CHANNEL #
2000,,D ;MAIN CURSOR POSITION
402000,,R ;ECHO CURSOR POSITION
;;; STANDARD **MORE** PROCESSOR
TTYMOR: PUSHJ P,STTYCONS ;SUBR 1
JUMPE A,CPOPJ ;STTYCONS LEFT ARG IN AR1
STRT AR1,[SIXBIT \####MORE####!\] ;# IS QUOTE CHAR
PUSH P,AR1
PUSH P,[TTYMO2] ;FOR %TYI
PUSH P,A
PUSH P,[TTYMO1] ;FOR TYIPEEK
PUSH P,R70
PUSH P,A
MOVNI T,2
JRST TYIPEEK+1
TTYMO1: MOVNI T,1
CAIE TT,40
CAIN TT,177
JRST %TYI+1 ;SWALLOW SPACE OR RUBOUT
SUB P,R70+2
TTYMO2: POP P,AR1
MOVE D,[10,,"H] ;GO TO BEGINNING OF LINE
PUSHJ P,CNPCOD
PUSHJ P,CNPL ;CLEAR TO END OF LINE
MOVEI D,"T ;GO TO TOP OF SCREEN
PUSHJ P,CNPCOD
JRST CNPL ;CLEAR THAT LINE TOO
PGTOP QIO,[NEW I/O PACKAGE]